#1
|
|||
|
|||
Get row number from address
Hi All,
This workbook is designed for looking up Electronic component stock location and additional data, stock tracking and to compare against a bill of materials and output a list of parts on hand, and a new bill of materials for purchasing. Attached is the Workbook with lots of sample data for setting up the vba code for the searches. I am using the code shown to create a table of rows found in several worksheets, this works fine and returns does create a table from the found data and creates a list of rows in a table for each worksheet. My problem is that it is finding the same data in a row were it has more than one value and returning that row as well, so the same row may show up more than once. What I need to do is use the row number to check if it is allready in the list and bypass that row as it is allready in the table. To do this I have to extrapolate the row number from the address were that data is found and check if it is in the table allready. I need to use left, mid, right to return just the row number or is there an easy way to get it, even if the row number could be 1, 10, 100, 1000, 10000 Code:
Sub TextBox1_Click() Dim ws As Worksheet, Found As Range Dim myText As String, FirstAddress As String Dim AddressStr As String, foundNum As Integer Dim LastRow As Long myText = Worksheets("instructions").Range("G6") If myText = "" Then Exit Sub re = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Address Worksheets("instructions").Range("A16:BB100").Delete For Each ws In ThisWorkbook.Worksheets With ws If ws.Name = "Instructions" Or ws.Name = "Storage Locations" Then GoTo myNext t = ws.Name Set Found = .Range("B3:AD10000").Find(What:=myText, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False) If Not Found Is Nothing Then If Not foundNum > 1 Then Worksheets("instructions").Range("A17").Value = "Sheet & Location" tbl_start = Worksheets("instructions").Range("A" & 17 + foundNum).Address tbl = Worksheets("instructions").Range("A" & "17" + foundNum).Address Worksheets(ws.Name).Range("B2:L2").Copy Worksheets("instructions").Range("B17").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Else foundNum = foundNum + 1 Worksheets("instructions").Range("A" & 17 + foundNum).Value = "Sheet & Location" tbl_start = Worksheets("instructions").Range("A" & 17 + foundNum).Address tbl = Worksheets("instructions").Range("A" & 17 + foundNum).Address Worksheets(ws.Name).Range("B2:L2").Copy Worksheets("instructions").Range("B" & 17 + foundNum).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False End If FirstAddress = Found.Address Do foundNum = foundNum + 1 AddressStr = .Name & " " & Found.Address & vbCrLf addr = Found.Address Set Found = .Range("B3:AD10000").FindNext(Found) row18 = foundNum + 17 Found.EntireRow.Copy Destination:=Worksheets("instructions").Range("A" & row18) Worksheets("instructions").Range("AA1") = AddressStr Range("AA1").Copy Range("A" & row18).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False tt = ws.Name ActiveSheet.Hyperlinks.Add Anchor:=Worksheets("instructions").Range("A" & row18), Address:="", SubAddress:=ws.Name + "!" + addr, TextToDisplay:=AddressStr Range("A" & row18 & ":AD" & row18).Select Range("A" & row18 & ":AD" & row18).Borders(xlEdgeLeft).LineStyle = xlContinuous Range("A" & row18 & ":AD" & row18).Borders(xlEdgeLeft).Weight = xlThin Range("A" & row18 & ":AD" & row18).Borders(xlEdgeTop).LineStyle = xlContinuous Range("A" & row18 & ":AD" & row18).Borders(xlEdgeTop).Weight = xlThin Range("A" & row18 & ":AD" & row18).Borders(xlEdgeBottom).LineStyle = xlContinuous Range("A" & row18 & ":AD" & row18).Borders(xlEdgeBottom).Weight = xlThin Range("A" & row18 & ":AD" & row18).Borders(xlEdgeRight).LineStyle = xlContinuous Range("A" & row18 & ":AD" & row18).Borders(xlEdgeRight).Weight = xlThin Range("A" & row18 & ":AD" & row18).Borders(xlInsideVertical).LineStyle = xlContinuous Range("A" & row18 & ":AD" & row18).Borders(xlInsideVertical).Weight = xlThin Range("A" & row18 & ":AD" & row18).Borders(xlInsideHorizontal).LineStyle = xlContinuous Range("A" & row18 & ":AD" & row18).Borders(xlInsideHorizontal).Weight = xlThin Loop While Not Found Is Nothing And Found.Address <> FirstAddress End If If Not Found Is Nothing Then foundNum = foundNum + 1 ActiveSheet.ListObjects.Add(xlSrcRange, Range(tbl_start & ":$L$" & row18), , xlYes).Name = "Table" & foundNum Call addborders End If myNext: End With Next ws If Len(AddressStr) Then Else: MsgBox "Unable to find " & myText & " in this workbook.", vbExclamation End If Dim lLastRow As Long, lLastColumn As Long Dim lRealLastRow As Long, lRealLastColumn As Long With Range("A1").SpecialCells(xlCellTypeLastCell) lLastRow = .Row lLastColumn = .Column End With lRealLastRow = Cells.Find("*", Range("A1"), xlFormulas, , xlByRows, xlPrevious).Row lRealLastColumn = Cells.Find("*", Range("A1"), xlFormulas, , xlByColumns, xlPrevious).Column If lRealLastRow < lLastRow Then Range(Cells(lRealLastRow + 1, 1), Cells(lLastRow, 1)).EntireRow.Delete End If If lRealLastColumn < lLastColumn Then Range(Cells(1, lRealLastColumn + 1), Cells(1, lLastColumn)).EntireColumn.Delete End If ActiveSheet.UsedRange 'Resets LastCell Worksheets("instructions").Range("G6").Select End Sub |
#2
|
|||
|
|||
An easier way....
remove the ":" and first character from the address string then split it into its parts. This will show in the Immediate Window what you're dealing with. Code:
Sub Parts_of_Address() AddressStr = ActiveCell.CurrentRegion.Address Debug.Print Mid(AddressStr, 2) parts = Split(Mid(Replace(AddressStr, ":", ""), 2), "$") For i = LBound(parts) To UBound(parts) Debug.Print i, parts(i) Next i End Sub |
#3
|
|||
|
|||
Thanks for the reply, but I found that I can use the .row to get just the row number from the address, this works ok, and now I'm trying to implement it with the code below, just trying various thing to try and get a result at the moment.
the code in red is what I am trying to add, but it's not working as yet... Code:
For Each ws In ThisWorkbook.Worksheets With ws If ws.Name = "Instructions" Or ws.Name = "Storage Locations" Then GoTo myNext t = ws.Name Set Found = .Range("B3:AD10000").Find(What:=myText, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False) If Not Found Is Nothing Then If Not foundNum > 1 Then Worksheets("instructions").Range("A17").Value = "Sheet & Location" tbl_start = Worksheets("instructions").Range("A" & 17 + foundNum).Address rr1 = Found.Row trng = Range(tbl_start, "A" & 17 + foundNum).Address Worksheets(ws.Name).Range("B2:AA2").Copy Worksheets("instructions").Range("B17").Select Else foundNum = foundNum + 1 Worksheets("instructions").Range("A" & 17 + foundNum).Value = "Sheet & Location" tbl_start = Worksheets("instructions").Range("A" & 17 + foundNum).Address rr1 = Found.Row trng = Range(tbl_start, "A" & 17 + foundNum).Address Worksheets(ws.Name).Range("B2:AA2").Copy Worksheets("instructions").Range("B" & 17 + foundNum).Select End If Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False FirstAddress = Found.Address Do foundNum = foundNum + 1 AddressStr = .Name & " " & Found.Address & vbCrLf addr = Found.Address Set Found = .Range("B3:AD10000").FindNext(Found) r1 = Found.Row ttt = rr1 ll = Len(r1) trng = Range("A18:A" & 17 + foundNum - 1).Address ttt = Split(trng, "$")(2) If WorksheetFunction.CountIf(Range(trng), r1) = 0 Then g = 1 Else g = 2 End If row18 = foundNum + 17 Found.EntireRow.Copy Destination:=Worksheets("instructions").Range("A" & row18) Worksheets("instructions").Range("AA1") = AddressStr Range("AA1").Copy Range("A" & row18).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False tt = ws.Name ActiveSheet.Hyperlinks.Add Anchor:=Worksheets("instructions").Range("A" & row18), Address:="", SubAddress:=ws.Name + "!" + addr, TextToDisplay:=AddressStr Loop While Not Found Is Nothing And Found.Address <> FirstAddress End If If Not Found Is Nothing Then foundNum = foundNum + 1 ActiveSheet.ListObjects.Add(xlSrcRange, Range(tbl_start & ":$AA$" & row18), , xlYes).Name = "Table" & foundNum End If myNext: End With Next ws |
#4
|
|||
|
|||
Found is not an address, it's a range.
I have no idea what your code in red is supposed to be doing. I'd suggest you insert this line immediately ahead of the red code Code:
Stop Hover your mouse over the various variables to see if they are what you expect. |
#5
|
|||
|
|||
Thanks again for the reply,
I have progressed a bit with this and have the following code listed below, it is creating a list of row numbers on a check sheet, i am then trying to check this against each new found row to see if is listed, if it's not then i want to add the found row, otherwise keep checking the sheet until all checked then procede to the next worksheet. I think the problem I am having now is the way find and find next are getting the row and then the 'do' action with this value. Still debugging 1 line at a time to try and find how to get it correct. snipet from above code with current changes in red Code:
If Not Found Is Nothing Then If Not foundNum > 1 Then Worksheets("instructions").Range("A17").Value = "Sheet & Location" tbl_start = Worksheets("instructions").Range("A" & 17 + foundNum).Address r1 = Found.Row trng = Range(tbl_start, "A" & 17 + foundNum).Address Worksheets(ws.Name).Range("B2:AA2").Copy Worksheets("instructions").Range("B17").Select Worksheets("check sheet").Range("A1" & foundNum).Value = r1 Else foundNum = foundNum + 1 Worksheets("instructions").Range("A" & 17 + foundNum).Value = "Sheet & Location" tbl_start = Worksheets("instructions").Range("A" & 17 + foundNum).Address r1 = Found.Row trng = Range(tbl_start, "A" & 17 + foundNum).Address Worksheets(ws.Name).Range("B2:AA2").Copy Worksheets("instructions").Range("B" & 17 + foundNum).Select Worksheets("check sheet").Range("A1" & foundNum).Value = r1 End If Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False FirstAddress = Found.Address Do foundNum = foundNum + 1 AddressStr = .Name & " " & Found.Address & vbCrLf addr = Found.Address Set Found = .Range("B3:AD10000").FindNext(Found) r1 = Found.Row If WorksheetFunction.CountIf(Worksheets("check sheet").Range("A1:A1000"), r1) = 0 Then ' not found Else 'found ' GoTo next_worksheet End If Worksheets("check sheet").Range("A1" & foundNum).Value = r1 |
#6
|
|||
|
|||
problem solved
For anybody thats interested, I have solved my problems with this part of the code, as shown below...
Code:
Sub TextBox1_Click() Dim ws As Worksheet, Found As Range Dim myText As String, FirstAddress As String Dim AddressStr As String, foundNum As Integer Dim LastRow As Long myText = Worksheets("instructions").Range("G6") If myText = "" Then Exit Sub re = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Address Worksheets("instructions").Range("A16:BB100").Delete Worksheets("check sheet").Range("A1:A1000").Delete For Each ws In ThisWorkbook.Worksheets With ws If ws.Name = "Instructions" Or ws.Name = "Storage Locations" Then GoTo myNext t = ws.Name Set Found = .Range("B3:AD10000").Find(What:=myText, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False) If Not Found Is Nothing Then If Not foundNum > 1 Then Worksheets("instructions").Range("A17").Value = "Sheet & Location" Worksheets("instructions").Range("A" & 17 + foundNum).Font.Bold = True tbl_start = Worksheets("instructions").Range("A" & 17 + foundNum).Address r1 = Found.Row trng = Range(tbl_start, "A" & 17 + foundNum).Address Worksheets(ws.Name).Range("B2:AA2").Copy Worksheets("instructions").Range("B17").Select Worksheets("check sheet").Range("A1" & foundNum).Value = r1 Else foundNum = foundNum + 1 Worksheets("instructions").Range("A" & 17 + foundNum).Value = "Sheet & Location" Worksheets("instructions").Range("A" & 17 + foundNum).Font.Bold = True tbl_start = Worksheets("instructions").Range("A" & 17 + foundNum).Address r1 = Found.Row trng = Range(tbl_start, "A" & 17 + foundNum).Address Worksheets(ws.Name).Range("B2:AA2").Copy Worksheets("instructions").Range("B" & 17 + foundNum).Select Worksheets("check sheet").Range("A1" & foundNum).Value = r1 End If Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Selection.Font.Bold = True FirstAddress = Found.Address Do foundNum = foundNum + 1 AddressStr = .Name & " " & Found.Address & vbCrLf addr = Found.Address Set Found = .Range("B3:AD10000").FindNext(Found) r1 = Found.Row If WorksheetFunction.CountIf(Worksheets("check sheet").Range("A1:A1000"), r1) < 2 Then Else GoTo next_worksheet End If Worksheets("check sheet").Range("A1" & foundNum).Value = r1 row18 = foundNum + 17 Found.EntireRow.Copy Destination:=Worksheets("instructions").Range("A" & row18) Worksheets("instructions").Range("AA1") = AddressStr Range("AA1").Copy Range("A" & row18).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False tt = ws.Name ActiveSheet.Hyperlinks.Add Anchor:=Worksheets("instructions").Range("A" & row18), Address:="", SubAddress:=ws.Name + "!" + addr, TextToDisplay:=AddressStr Range("A" & row18 & ":AD" & row18).Select Range("A" & row18 & ":AD" & row18).Borders(xlEdgeLeft).LineStyle = xlContinuous Range("A" & row18 & ":AD" & row18).Borders(xlEdgeLeft).Weight = xlThin Range("A" & row18 & ":AD" & row18).Borders(xlEdgeTop).LineStyle = xlContinuous Range("A" & row18 & ":AD" & row18).Borders(xlEdgeTop).Weight = xlThin Range("A" & row18 & ":AD" & row18).Borders(xlEdgeBottom).LineStyle = xlContinuous Range("A" & row18 & ":AD" & row18).Borders(xlEdgeBottom).Weight = xlThin Range("A" & row18 & ":AD" & row18).Borders(xlEdgeRight).LineStyle = xlContinuous Range("A" & row18 & ":AD" & row18).Borders(xlEdgeRight).Weight = xlThin Range("A" & row18 & ":AD" & row18).Borders(xlInsideVertical).LineStyle = xlContinuous Range("A" & row18 & ":AD" & row18).Borders(xlInsideVertical).Weight = xlThin Range("A" & row18 & ":AD" & row18).Borders(xlInsideHorizontal).LineStyle = xlContinuous Range("A" & row18 & ":AD" & row18).Borders(xlInsideHorizontal).Weight = xlThin Loop While Not Found Is Nothing And Found.Address <> FirstAddress End If If Not Found Is Nothing Then foundNum = foundNum + 1 ActiveSheet.ListObjects.Add(xlSrcRange, Range(tbl_start & ":$AA$" & row18), , xlYes).Name = "Table" & foundNum Range("A" & row18 & ":AD" & row18).Select Range("A" & row18 & ":AD" & row18).Borders(xlEdgeLeft).LineStyle = xlContinuous Range("A" & row18 & ":AD" & row18).Borders(xlEdgeLeft).Weight = xlThin Range("A" & row18 & ":AD" & row18).Borders(xlEdgeTop).LineStyle = xlContinuous Range("A" & row18 & ":AD" & row18).Borders(xlEdgeTop).Weight = xlThin Range("A" & row18 & ":AD" & row18).Borders(xlEdgeBottom).LineStyle = xlContinuous Range("A" & row18 & ":AD" & row18).Borders(xlEdgeBottom).Weight = xlThin Range("A" & row18 & ":AD" & row18).Borders(xlEdgeRight).LineStyle = xlContinuous Range("A" & row18 & ":AD" & row18).Borders(xlEdgeRight).Weight = xlThin Range("A" & row18 & ":AD" & row18).Borders(xlInsideVertical).LineStyle = xlContinuous Range("A" & row18 & ":AD" & row18).Borders(xlInsideVertical).Weight = xlThin Range("A" & row18 & ":AD" & row18).Borders(xlInsideHorizontal).LineStyle = xlContinuous Range("A" & row18 & ":AD" & row18).Borders(xlInsideHorizontal).Weight = xlThin End If myNext: End With next_worksheet: Next ws If Len(AddressStr) Then Else: MsgBox "Unable to find " & myText & " in this workbook.", vbExclamation End If Dim lLastRow As Long, lLastColumn As Long Dim lRealLastRow As Long, lRealLastColumn As Long With Range("A1").SpecialCells(xlCellTypeLastCell) lLastRow = .Row lLastColumn = .Column End With lRealLastRow = Cells.Find("*", Range("A1"), xlFormulas, , xlByRows, xlPrevious).Row lRealLastColumn = Cells.Find("*", Range("A1"), xlFormulas, , xlByColumns, xlPrevious).Column If lRealLastRow < lLastRow Then Range(Cells(lRealLastRow + 1, 1), Cells(lLastRow, 1)).EntireRow.Delete End If If lRealLastColumn < lLastColumn Then Range(Cells(1, lRealLastColumn + 1), Cells(1, lLastColumn)).EntireColumn.Delete End If ActiveSheet.UsedRange 'Resets LastCell Worksheets("instructions").Range("G6").Select End Sub |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Differentiate between my address and my address in a Distribution List | fogyreef | Outlook | 1 | 01-14-2016 12:45 AM |
Add link to email address that hides the actual address or makes it inaccessible to online bots | richiebabes | Word | 1 | 09-03-2014 03:22 PM |
How to forward all e-mails from one address to five (5) other e-mail address? | adi2012 | Outlook | 1 | 09-09-2012 06:41 PM |
HELP! Outlook 2003 Address Books - multiple account address lists | ukmonkeynuts | Outlook | 0 | 06-01-2011 06:18 AM |
Default Home Address over Business Address | DunnDeal | Outlook | 1 | 12-03-2010 04:56 PM |