Excel matching with VBA

Question

I am trying to work out the looping on my script but have found it difficult to figure out. I am using this script to find matching data from different sources and reference them together. I would use the built-in functions in excel but it doesn't care about finding the same data more than once.

1. Read the titles of all the spreadsheets in the book. #Works
2. Make an array with those titles #Works
3. Filter out the "current" sheet #Works
4. Reference each cell in column A on "current" sheet against all the cells on all the pages in column H #Works
5. If it matches one, take the data from the page it was found on and the data in column G then set that as the value on "current" page in column E #Works
6. Make the next page in the main sheet array the "current" page and do it all over again #Doesn't Work

I didn't think this would be as complicated as it is, and maybe I'm not helping by not using functions. Got any idea on how to advance inspectSheet correctly?

Sub listsheets()
Dim ws As Worksheet
Dim i As Integer
Dim x As Integer
Dim y As Integer
Dim sheetArray() As Variant

x = 0
y = 0
i = 0

For Each ws In Worksheets
    ReDim Preserve sheetArray(i)
    sheetArray(i) = ws.Name
    i = i + 1
Next ws

Do Until i = 1
    i = i - 1
    inspectSheet = sheetArray(x)
    column = Sheets(inspectSheet).Cells(Rows.Count, "A").End(xlUp).Row
    matchArray = Filter(sheetArray, inspectSheet, False, vbTextCompare)
    HOLDER = Join(matchArray)
    matchSheet = matchArray(y)
    Do Until column = 1
        currentCell = Sheets(inspectSheet).Cells(column, 1).Value
        checkListLength = Sheets(matchSheet).Cells(Rows.Count, "H").End(xlUp).Row
        Do Until checkListLength = 1
            matchCell = Sheets(matchSheet).Cells(checkListLength, 8).Value
            Debug.Print "Checking: " + currentCell + " on " + inspectSheet + " against " + matchCell + " from page " + matchSheet
            If currentCell = matchCell Then
                Sheets(inspectSheet).Cells(column, 5).Value = matchSheet + " on " + Sheets(matchSheet).Cells(checkListLength, 7).Value
            End If
            checkListLength = checkListLength - 1
        Loop
        column = column - 1
       
    Loop
     y = y + 1
Loop
x = x + 1
End Sub

Answer 1

I see you already answered your own question, but here's a slightly different approach with fewer counters to track:

Sub listsheets()
    
    Dim wsMatch As Worksheet, wsInspect As Worksheet
    Dim currVal
    Dim cInspect As Range, cMatch As Range, rngMatch As Range, rngInspect As Range

    For Each wsInspect In ThisWorkbook.Worksheets
        
        Set rngInspect = wsInspect.Range("A1:A" & wsInspect.Cells(Rows.Count, "A").End(xlUp).Row)
        
        For Each wsMatch In ThisWorkbook.Worksheets
            
            If wsMatch.Name <> wsInspect.Name Then 'filter out same-name pairs...
                
                Set rngMatch = wsMatch.Range("H1:H" & wsMatch.Cells(Rows.Count, "H").End(xlUp).Row)
                For Each cInspect In rngInspect.Cells
                    currVal = cInspect.Value
                    For Each cMatch In rngMatch.Cells
                        If cMatch.Value = currVal Then
                            cInspect.EntireRow.Columns("E").Value = _
                                wsMatch.Name & " on " & cMatch.Offset(0, -1).Value
                        End If
                    Next cMatch
                Next cInspect
            
            End If  'checking these sheets
        Next wsMatch
        
    Next wsInspect

End Sub

Answer 2

I got it, I was not resetting my counter variables and needed one more external loop to advance. The finished code is:

Sub listsheets()
Dim ws As Worksheet
Dim i As Integer
Dim x As Integer
Dim y As Integer
Dim limit As Integer
Dim sheetArray() As Variant

x = 0
y = 0
i = 0

For Each ws In Worksheets
    ReDim Preserve sheetArray(i)
    sheetArray(i) = ws.Name
    i = i + 1
Next ws

limit = UBound(sheetArray)
Do Until x = limit
    Do Until i = 1
        i = i - 1
        inspectSheet = sheetArray(x)
        Column = Sheets(inspectSheet).Cells(Rows.Count, "A").End(xlUp).Row
        matchArray = Filter(sheetArray, inspectSheet, False, vbTextCompare)
        HOLDER = Join(matchArray)
        matchSheet = matchArray(y)
        Do Until Column = 1
            currentCell = Sheets(inspectSheet).Cells(Column, 1).Value
            checkListLength = Sheets(matchSheet).Cells(Rows.Count, "H").End(xlUp).Row
            Do Until checkListLength = 1
                matchCell = Sheets(matchSheet).Cells(checkListLength, 8).Value
                Debug.Print "Checking: " + currentCell + " on " + inspectSheet + " against " + matchCell + " from page " + matchSheet
                If currentCell = matchCell Then
                    Sheets(inspectSheet).Cells(Column, 5).Value = matchSheet + " on " + Sheets(matchSheet).Cells(checkListLength, 7).Value
                End If
                checkListLength = checkListLength - 1
            Loop
            Column = Column - 1
        Loop
        y = y + 1
    Loop
    i = UBound(sheetArray)
    y = 0
    x = x + 1
Loop

End Sub