Microsoft Office Forums

Go Back   Microsoft Office Forums > >
Reload this Page Get row number from address
Register FAQ

Reply
 
Thread Tools Display Modes
  #1  
Old 01-12-2017, 11:26 PM
trevorc trevorc is offline Get row number from address Windows 7 32bit Get row number from address Office 2013
Competent Performer
Get row number from address 		 
Join Date: Jan 2017
Posts: 173
trevorc will become famous soon enoughtrevorc will become famous soon enough
Default 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

Attached Files
File Type: xlsm Component List and Locations.xlsm (93.2 KB, 11 views)
Reply With Quote
  #2  
Old 01-13-2017, 08:47 AM
NoSparks NoSparks is offline Get row number from address Windows 7 64bit Get row number from address Office 2010 64bit
Excel Hobbyist
  
Join Date: Nov 2013
Location: British Columbia, Canada
Posts: 842
NoSparks is a glorious beacon of lightNoSparks is a glorious beacon of lightNoSparks is a glorious beacon of lightNoSparks is a glorious beacon of lightNoSparks is a glorious beacon of light
Default
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
Reply With Quote
  #3  
Old 01-13-2017, 10:32 PM
trevorc trevorc is offline Get row number from address Windows 7 32bit Get row number from address Office 2013
Competent Performer
Get row number from address 		 
Join Date: Jan 2017
Posts: 173
trevorc will become famous soon enoughtrevorc will become famous soon enough
Default
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
Reply With Quote
  #4  
Old 01-13-2017, 11:58 PM
NoSparks NoSparks is offline Get row number from address Windows 7 64bit Get row number from address Office 2010 64bit
Excel Hobbyist
  
Join Date: Nov 2013
Location: British Columbia, Canada
Posts: 842
NoSparks is a glorious beacon of lightNoSparks is a glorious beacon of lightNoSparks is a glorious beacon of lightNoSparks is a glorious beacon of lightNoSparks is a glorious beacon of light
Default
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
Then use the F8 key to step through the code one line at a time.
Hover your mouse over the various variables to see if they are what you expect.
Reply With Quote
  #5  
Old 01-14-2017, 01:21 AM
trevorc trevorc is offline Get row number from address Windows 7 32bit Get row number from address Office 2013
Competent Performer
Get row number from address 		 
Join Date: Jan 2017
Posts: 173
trevorc will become famous soon enoughtrevorc will become famous soon enough
Default
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
Reply With Quote
  #6  
Old 01-14-2017, 03:39 AM
trevorc trevorc is offline Get row number from address Windows 7 32bit Get row number from address Office 2013
Competent Performer
Get row number from address 		 
Join Date: Jan 2017
Posts: 173
trevorc will become famous soon enoughtrevorc will become famous soon enough
Default 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
Reply With Quote
Reply

« Previous Thread | Next Thread »


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
Get row number from address 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

Other Forums: Access Forums

All times are GMT -7. The time now is 04:42 PM.

Contact Us - Privacy Statement - Top

Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2025, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2025 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft