Search code examples
excelvbagoogle-sheets

Worksheets("X").Cells(row, column) not copying values from multiple sheets

I have an issue that is related with the Worksheets("X").Cells(row, column) statement, situation is:

3 sheets in the workbook: "X", "Y", "Z"

Sheet "X" has 2 columns (A and B) filled with data in all 100 rows from 1 to 100 Sheet "Y" has 2 columns (A and B) filled with data in all 500 rows from 1 to 500 Sheet "Z" has 4 columns (A to D) filled with no data in all 100 rows

The target here is:

I need to find the matched values between sheet "X" and "Y" and transfer the values to sheet "Z".

From sheet "X", pick up the first cell (A1) and compare with sheet "Y" first cell (A1) If they are equal, we should copy the value of both A1 and B1 from sheets "X" and "Y" to sheet "Z" A1,B1,C1,D1 respectively.

The comparison should repeat for each cell in "A" column of sheet "X" to all 500 cells of "A" column of sheet "Y".

It looks like two loops, one inside other. Try to run this code but it does not work (the Z sheets is always "blank").

Maybe I need to "Select" and "Activate" the sheets, once we are working with multiple sheets? Not sure how to do it inside the "For" loop.

Any hint why it happens and how to solve?

This is the how the sheets look like and the code I tried without success:

enter image description here

Created a UserForm1 and a simple CommandButton1. When we click the button the code should be executed:

Private Sub CommandButton1_Click()

Dim row1 As Integer
Dim row2 As Integer

Worksheets(Array("X", "Y", "Z")).Select


For row1 = 1 To 100

    For row2 = 1 To 500


        If Worksheets("X").Cells(row1, 1) = Worksheets("Y").Cells(row2, 1) Then

            Worksheets("Z").Cells(row1, 1) = Worksheets("X").Cells(row2, 1)
            Worksheets("Z").Cells(row1, 2) = Worksheets("X").Cells(row2, 2)
            Worksheets("Z").Cells(row1, 3) = Worksheets("Y").Cells(row2, 1)
            Worksheets("Z").Cells(row1, 4) = Worksheets("Y").Cells(row2, 2)
    

        End If

        Exit For  

    Next

Next


End Sub
Solution

  • I think, you don't need to use select for this case. You can reference the sheets and cells without activating them. Below code is self-explanatory by breaking it down into separate functions.

    Sub Main()
    Dim wsX As Worksheet, wsY As Worksheet, wsZ As Worksheet
    Dim nextRowZ As Long, i As Long, matchingRowY As Long

    Set wsX = ThisWorkbook.Worksheets("X")
    Set wsY = ThisWorkbook.Worksheets("Y")
    Set wsZ = ThisWorkbook.Worksheets("Z")

    nextRowZ = 1

    For i = 1 To GetLastRow(wsX, 1)
        matchingRowY = GetMatchingRowSidebySide(wsX, wsY, i)
        
        If matchingRowY <> -1 Then
            wsZ.Cells(nextRowZ, 1).Value = wsX.Cells(i, 1).Value
            wsZ.Cells(nextRowZ, 2).Value = wsX.Cells(i, 2).Value
            wsZ.Cells(nextRowZ, 3).Value = wsY.Cells(matchingRowY, 1).Value
            wsZ.Cells(nextRowZ, 4).Value = wsY.Cells(matchingRowY, 2).Value
        End If

        nextRowZ = nextRowZ + 1
    Next i

End Sub
Function GetMatchingRowSidebySide(wsX As Worksheet, wsY As Worksheet, xRow As Long) As Long
 Dim j As Long
    For j = 1 To GetLastRow(wsY, 1)
        If wsX.Cells(xRow, 1).Value = wsY.Cells(j, 1).Value Then
            GetMatchingRowSidebySide = j
            Exit Function
        End If
    Next j
    GetMatchingRowSidebySide = -1
End Function

Sub TransferValues(wsX As Worksheet, wsY As Worksheet, wsZ As Worksheet, xRow As Long, yRow As Long, zRow As Long)
    wsZ.Cells(zRow, 1).Value = wsX.Cells(xRow, 1).Value
    wsZ.Cells(zRow, 2).Value = wsX.Cells(xRow, 2).Value
    wsZ.Cells(zRow, 3).Value = wsY.Cells(yRow, 1).Value
    wsZ.Cells(zRow, 4).Value = wsY.Cells(yRow, 2).Value
End Sub

Function GetLastRow(ws As Worksheet, col As Long) As Long
    GetLastRow = ws.Cells(ws.Rows.Count, col).End(xlUp).Row
End Function