I'm having difficulty with aligning data in excel while using a macro.

The data in wb1 is for example like this:

Thomas    10
Jason     11
(blank)   (blank)
Clara     14

The data in wb2 is for example like this:

Thomas    12
Clara     14
(blank)   (blank)
Jason     20

I want the output to be based on the second wb2 and look like this:

Thomas     10           Thomas    12
Clara      14           Clara     14
(blank)    (blank)      (blank)   (blank)
Jason      11           Jason     20

Current code I have:

Sub RetrieveDataAndPaste()

    Dim mainSheet As Worksheet
    Dim filePath As String
    Dim fileName1 As String, fileName2 As String
    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lastRow1 As Long, lastRow2 As Long, i As Long, j As Long
    Dim matchFound As Boolean
    Dim nextRow As Long
    
    ' Set the main sheet and file paths from the "Main" sheet
    Set mainSheet = ThisWorkbook.Sheets("Main")
    filePath = mainSheet.Range("A1").Value
    fileName1 = mainSheet.Range("A2").Value
    fileName2 = mainSheet.Range("A3").Value
    
    ' Clear previous data in columns B to E
    mainSheet.Range("B:E").ClearContents
    
    ' Open the first file
    Set wb1 = Workbooks.Open(filePath & "\" & fileName1)
    Set ws1 = wb1.Sheets(1) ' Assuming data is in the first sheet of the first workbook
    
    ' Open the second file
    Set wb2 = Workbooks.Open(filePath & "\" & fileName2)
    Set ws2 = wb2.Sheets(1) ' Assuming data is in the first sheet of the second workbook
    
    ' Find the last row of data in column B of the first workbook
    lastRow1 = ws1.Cells(ws1.Rows.Count, "B").End(xlUp).Row
    ' Find the last row of data in column B of the second workbook
    lastRow2 = ws2.Cells(ws2.Rows.Count, "B").End(xlUp).Row
    
    ' Loop through each row in the first workbook and paste data
    For i = 2 To lastRow1 ' Starting from the second row of data in the first file
        mainSheet.Cells(i - 1, 2).Value = ws1.Cells(i, 2).Value ' Paste column B from first file to column B
        mainSheet.Cells(i - 1, 3).Value = ws1.Cells(i, 20).Value ' Paste column T from first file to column C
    Next i
    
    ' Loop through each row in the second workbook and paste data, aligning based on column B
    For i = 2 To lastRow2 ' Starting from the second row of data in the second file
        matchFound = False
        
        ' Try to find a matching value in column B of the first file
        For j = 2 To lastRow1
            If ws2.Cells(i, 2).Value = ws1.Cells(j, 2).Value Then
                ' Match found: paste data from second workbook in the same row as first workbook
                mainSheet.Cells(j - 1, 4).Value = ws2.Cells(i, 2).Value ' Paste column B from second file to column D
                mainSheet.Cells(j - 1, 5).Value = ws2.Cells(i, 20).Value ' Paste column T from second file to column E
                matchFound = True
                Exit For
            End If
        Next j
        
        ' If no match is found, insert a new row in the "Main" sheet and paste data
        If Not matchFound Then
            ' Find the next available row
            nextRow = mainSheet.Cells(mainSheet.Rows.Count, 2).End(xlUp).Row + 1
            
            ' Paste the data into the new row
            mainSheet.Cells(nextRow, 2).Value = ws2.Cells(i, 2).Value ' Paste column B from second file to column B
            mainSheet.Cells(nextRow, 3).Value = ws2.Cells(i, 20).Value ' Paste column T from second file to column C
        End If
    Next i
    
    ' Optional: Close the workbooks after the operation
    wb1.Close SaveChanges:=False
    wb2.Close SaveChanges:=False 
End Sub

I'm having difficulty with aligning data in excel while using a macro.

The data in wb1 is for example like this:

Thomas    10
Jason     11
(blank)   (blank)
Clara     14

The data in wb2 is for example like this:

Thomas    12
Clara     14
(blank)   (blank)
Jason     20

I want the output to be based on the second wb2 and look like this:

Thomas     10           Thomas    12
Clara      14           Clara     14
(blank)    (blank)      (blank)   (blank)
Jason      11           Jason     20

Current code I have:

Sub RetrieveDataAndPaste()

    Dim mainSheet As Worksheet
    Dim filePath As String
    Dim fileName1 As String, fileName2 As String
    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lastRow1 As Long, lastRow2 As Long, i As Long, j As Long
    Dim matchFound As Boolean
    Dim nextRow As Long
    
    ' Set the main sheet and file paths from the "Main" sheet
    Set mainSheet = ThisWorkbook.Sheets("Main")
    filePath = mainSheet.Range("A1").Value
    fileName1 = mainSheet.Range("A2").Value
    fileName2 = mainSheet.Range("A3").Value
    
    ' Clear previous data in columns B to E
    mainSheet.Range("B:E").ClearContents
    
    ' Open the first file
    Set wb1 = Workbooks.Open(filePath & "\" & fileName1)
    Set ws1 = wb1.Sheets(1) ' Assuming data is in the first sheet of the first workbook
    
    ' Open the second file
    Set wb2 = Workbooks.Open(filePath & "\" & fileName2)
    Set ws2 = wb2.Sheets(1) ' Assuming data is in the first sheet of the second workbook
    
    ' Find the last row of data in column B of the first workbook
    lastRow1 = ws1.Cells(ws1.Rows.Count, "B").End(xlUp).Row
    ' Find the last row of data in column B of the second workbook
    lastRow2 = ws2.Cells(ws2.Rows.Count, "B").End(xlUp).Row
    
    ' Loop through each row in the first workbook and paste data
    For i = 2 To lastRow1 ' Starting from the second row of data in the first file
        mainSheet.Cells(i - 1, 2).Value = ws1.Cells(i, 2).Value ' Paste column B from first file to column B
        mainSheet.Cells(i - 1, 3).Value = ws1.Cells(i, 20).Value ' Paste column T from first file to column C
    Next i
    
    ' Loop through each row in the second workbook and paste data, aligning based on column B
    For i = 2 To lastRow2 ' Starting from the second row of data in the second file
        matchFound = False
        
        ' Try to find a matching value in column B of the first file
        For j = 2 To lastRow1
            If ws2.Cells(i, 2).Value = ws1.Cells(j, 2).Value Then
                ' Match found: paste data from second workbook in the same row as first workbook
                mainSheet.Cells(j - 1, 4).Value = ws2.Cells(i, 2).Value ' Paste column B from second file to column D
                mainSheet.Cells(j - 1, 5).Value = ws2.Cells(i, 20).Value ' Paste column T from second file to column E
                matchFound = True
                Exit For
            End If
        Next j
        
        ' If no match is found, insert a new row in the "Main" sheet and paste data
        If Not matchFound Then
            ' Find the next available row
            nextRow = mainSheet.Cells(mainSheet.Rows.Count, 2).End(xlUp).Row + 1
            
            ' Paste the data into the new row
            mainSheet.Cells(nextRow, 2).Value = ws2.Cells(i, 2).Value ' Paste column B from second file to column B
            mainSheet.Cells(nextRow, 3).Value = ws2.Cells(i, 20).Value ' Paste column T from second file to column C
        End If
    Next i
    
    ' Optional: Close the workbooks after the operation
    wb1.Close SaveChanges:=False
    wb2.Close SaveChanges:=False 
End Sub

• excel
• vba
• match
• alignment

Share Improve this question Follow edited Mar 25 at 14:26 BigBen 50.2k77 gold badges2828 silver badges4444 bronze badges asked Mar 25 at 14:24 Someone ELSomeone EL 111 bronze badge 0

Add a comment  | 

1 Answer 1

Sorted by: Reset to default 0

The revised script follows your coding logic to make it easier for you to understand. You'll need to extract data from wb2 first, then from wb1. If you need to handle large amounts of data, loading it into an array is a more efficient approach.

Option Explicit

Sub RetrieveDataAndPaste()

    Dim mainSheet As Worksheet
    Dim filePath As String
    Dim fileName1 As String, fileName2 As String
    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lastRow1 As Long, lastRow2 As Long, i As Long, j As Long
    Dim matchFound As Boolean
    Dim nextRow As Long
    
    ' Set the main sheet and file paths from the "Main" sheet
    Set mainSheet = ThisWorkbook.Sheets("Main")
    filePath = mainSheet.Range("A1").Value
    fileName1 = mainSheet.Range("A2").Value
    fileName2 = mainSheet.Range("A3").Value
    
    ' Clear previous data in columns B to E
    mainSheet.Range("B:E").ClearContents
    
    ' Open the first file
    Set wb1 = Workbooks.Open(filePath & "\" & fileName1)
    Set ws1 = wb1.Sheets(1) ' Assuming data is in the first sheet of the first workbook
    
    ' Open the second file
    Set wb2 = Workbooks.Open(filePath & "\" & fileName2)
    Set ws2 = wb2.Sheets(1) ' Assuming data is in the first sheet of the second workbook
    
    ' Find the last row of data in column B of the first workbook
    lastRow1 = ws1.Cells(ws1.Rows.Count, "B").End(xlUp).Row
    ' Find the last row of data in column B of the second workbook
    lastRow2 = ws2.Cells(ws2.Rows.Count, "B").End(xlUp).Row
    
    ' Loop through each row in the second workbook and paste data
    For i = 2 To lastRow2
        mainSheet.Cells(i - 1, 4).Value = ws2.Cells(i, 2).Value
        mainSheet.Cells(i - 1, 5).Value = ws2.Cells(i, 20).Value
    Next i
    
    ' Loop through each row in the second workbook and paste data, aligning based on column B
    For i = 2 To lastRow1 ' Starting from the second row of data in the second file
        matchFound = False
        
        ' Try to find a matching value in column B of the second file
        For j = 2 To lastRow2
            If ws2.Cells(j, 2).Value = ws1.Cells(i, 2).Value Then
                mainSheet.Cells(j - 1, 2).Value = ws1.Cells(i, 2).Value
                mainSheet.Cells(j - 1, 3).Value = ws1.Cells(i, 20).Value
                matchFound = True
                Exit For
            End If
        Next j
        
        ' If no match is found, insert a new row in the "Main" sheet and paste data
        If Not matchFound Then
            ' Find the next available row
            nextRow = mainSheet.Cells(mainSheet.Rows.Count, 4).End(xlUp).Row + 1
            
            ' Paste the data into the new row
            mainSheet.Cells(nextRow, 2).Value = ws1.Cells(i, 2).Value ' Paste column B from first file to column B
            mainSheet.Cells(nextRow, 3).Value = ws1.Cells(i, 20).Value ' Paste column T from first file to column C
        End If
    Next i
    
    ' Optional: Close the workbooks after the operation
    wb1.Close SaveChanges:=False
    wb2.Close SaveChanges:=False
End Sub

---

Update:

Q: the first time the name occurs matches the first occurence of the wb1 and the second time it occurs it matches the second occurence from wb1 and so on

• Dictionary objects are used to count the occurrences of names and store their locations on the main sheet.

Sub RetrieveDataAndPaste()
    
    Dim mainSheet As Worksheet
    Dim filePath As String
    Dim fileName1 As String, fileName2 As String
    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lastRow1 As Long, lastRow2 As Long, i As Long, j As Long
    Dim matchFound As Boolean
    Dim nextRow As Long
    Dim nextRowB As Long
    Application.ScreenUpdating = False
    ' Set the main sheet and file paths from the "Main" sheet
    Set mainSheet = ThisWorkbook.Sheets("Main")
    filePath = mainSheet.Range("A1").Value
    fileName1 = mainSheet.Range("A2").Value
    fileName2 = mainSheet.Range("A3").Value
    
    ' Clear previous data in columns B to E
    mainSheet.Range("B:E").ClearContents
    
    ' Open the first file
    Set wb1 = Workbooks.Open(filePath & "\" & fileName1)
    Set ws1 = wb1.Sheets(1) ' Assuming data is in the first sheet of the first workbook
    
    ' Open the second file
    Set wb2 = Workbooks.Open(filePath & "\" & fileName2)
    Set ws2 = wb2.Sheets(1) ' Assuming data is in the first sheet of the second workbook
    
    ' Find the last row of data in column B of the first workbook
    lastRow1 = ws1.Cells(ws1.Rows.Count, "B").End(xlUp).Row
    ' Find the last row of data in column B of the second workbook
    lastRow2 = ws2.Cells(ws2.Rows.Count, "B").End(xlUp).Row
    ' copy column B and T from second workbook to column D and E in main sheet
    ws2.Range("B2:B" & lastRow2).Copy mainSheet.Range("D1")
    ws2.Range("T2:T" & lastRow2).Copy mainSheet.Range("E1")
    
    ' create dict object
    Dim dict1 As Object, dict2 As Object, sKey As String
    Set dict1 = CreateObject("Scripting.Dictionary")
    Set dict2 = CreateObject("Scripting.Dictionary")
    ' Loop through each row to collect its row number in dict2
    For i = 1 To lastRow2 - 1
        sKey = mainSheet.Cells(i, 4).Value
        If Not dict2.exists(sKey) Then
            Set dict2(sKey) = New Collection
        End If
        dict2(sKey).Add i
    Next i
    Dim iRow As Long

    ' Loop through each row in the first file
    For i = 2 To lastRow1 ' Starting from the second row of data in the second file
        sKey = ws1.Cells(i, 2).Value
        ' if not found in dict1 then add it, it exist then count it
        If Not dict1.exists(sKey) Then
            dict1(sKey) = 1
        Else
            dict1(sKey) = dict1(sKey) + 1
        End If
        matchFound = False
        ' Check if the key exists in dict2 and if the count is less than or equal to the number of occurrences
        If dict2.exists(sKey) Then
            If dict1(sKey) <= dict2(sKey).Count Then
                iRow = dict2(sKey)(dict1(sKey))
                matchFound = True
            End If
        End If
        ' If a match is found, paste the data into the corresponding row
        ' If not found, find the next available row and paste the data
        If matchFound Then
            mainSheet.Cells(iRow, 2).Value = sKey
            mainSheet.Cells(iRow, 3).Value = ws1.Cells(i, 20).Value
        Else
            ' Find the next available row, taking into account any existing data in column B and column D
            nextRowB = mainSheet.Cells(mainSheet.Rows.Count, 2).End(xlUp).Row + 1
            nextRow = mainSheet.Cells(mainSheet.Rows.Count, 4).End(xlUp).Row + 1
            If nextRow < nextRowB Then nextRow = nextRowB
            ' Paste the data into the new row
            mainSheet.Cells(nextRow, 2).Value = sKey ' Paste column B from first file to column B
            mainSheet.Cells(nextRow, 3).Value = ws1.Cells(i, 20).Value ' Paste column T from first file to column C
        End If
    Next i

    ' Optional: Close the workbooks after the operation
    wb1.Close SaveChanges:=False
    wb2.Close SaveChanges:=False
    Application.ScreenUpdating = True
End Sub