Edit to VBA code used to return worksheet location.

[H82BL8]

Hello,

I am currently using the below code to return the worksheet location of over 11,000 part numbers in a spreadsheet with 45 worksheets.

[COLOR=#333333][COLOR=#333333][I]Sub test()[/I][/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333][I]Dim a, i As Long, ws As Worksheet, r As Range[/I][/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333][I]With Sheets("Location_Summary").Cells(1).CurrentRegion[/I][/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333][I].Columns(3).Offset(1).ClearContents[/I][/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333][I]a = .Value[/I][/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333][I]For Each ws In Worksheets[/I][/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333][I]If ws.Name <> "Location_Summary" Then[/I][/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333][I]For i = 2 To UBound(a, 1)[/I][/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333][I]Set r = ws.Columns(1).Find(a(i, 1))[/I][/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333][I]If Not r Is Nothing Then[/I][/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333][I]a(i, 3) = a(i, 3) & IIf(a(i, 3) <> "", ", ", "") & ws.Name[/I][/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333][I]End If[/I][/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333][I]Next[/I][/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333][I]End If[/I][/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333][I]Next[/I][/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333][I].Resize(, 3).Value = a[/I][/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333][I]End With[/I][/COLOR][/COLOR]
[COLOR=#333333][COLOR=#333333][I]End Sub[/I][/COLOR][/COLOR]

This code has proved helpful for my problem, however I find it is returning not just the full search term, but it seems also when the search term is a partial match as well. I don't know VBA very well, and was hoping someone had a moment to advise if an edit to the code could result in returning exact matches only?

I look forward to hearing back from you.

Thank you in advance for your time and expertise.

 

[DanteAmor]

Try this

Sub test()
    Dim a, i As Long, ws As Worksheet, r As Range
    With Sheets("Location_Summary").Cells(1).CurrentRegion
        .Columns(3).Offset(1).ClearContents
        a = .Value
        For Each ws In Worksheets
            If ws.Name <> "Location_Summary" Then
                For i = 2 To UBound(a, 1)
                    Set r = ws.Columns(1).Find(a(i, 1), [COLOR=#0000ff]LookIn:=xlValues, lookat:=xlWhole[/COLOR])
                    If Not r Is Nothing Then
                        a(i, 3) = a(i, 3) & IIf(a(i, 3) <> "", ", ", "") & ws.Name
                    End If
                Next
            End If
        Next
        .Resize(, 3).Value = a
    End With
End Sub

 

[H82BL8]

Thank you very much.

 

[DanteAmor]

Thank you very much.

I'm glad to help you. Thanks for the feedback.