excelvbacopyadvanced-filter

Speeding up copying from another sheet in VBA using advanced filter


I'm very new to VBA and this community so I hope I'm not asking any stupid question and I apologize beforehand if the phrasing of my question isn't up to the standards.

I've been working on a code with the intention of going through a column and copying values from a column in a second sheet to an empty column in my main sheet based on a criteria, but I'm having a bit of a problem with the speed of this code since it takes a long time for me to see the results (sometimes it even crashes depending on the size of the data) Here's the concerning part of the code :

Dim x1 As Integer
Worksheets("A").Activate
x1 = ActiveSheet.UsedRange.Columns.Count
'Add a column in the end to put the add data
Worksheets("A").Cells(1, x1 + 1) = "added data"
Dim i As Integer
Dim j As Integer
Dim N1 As Integer
Dim N2 As Integer
N1 = Worksheets("A").Cells(Rows.Count, 1).End(xlUp).Row
N2 = Worksheets("B").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To N1
    For j = 2 To N2
        If Worksheets("B").Cells(j, 1).Value = Worksheets("A").Cells(i, 3).Value Then

        Worksheets("A").Cells(i, x1 + 1).Value = Worksheets("B").Cells(j, 3).Value

        GoTo NextIteration

        Else

        End If

   NextIteration:

   Next j

 Next i

As you can see, i already tried the GoTo NextIteration method which significantly reduced the time needed to execute the code, but I was wondering if there is a better/faster method to do this especially after learning about the speed of the AdvancedFilter function in VBA.

Also, please feel free to give me any instruction or advice even if it's not related to the main issue.

Have a lovely evening.


Solution

  • As stated in the comments, VLOOKUP may be your friend here. If, for some reason, you must programmatically append the "added data" column, here is a code example.

    Public Sub Test()
        Dim wsA As Excel.Worksheet
        Dim usedRngA As Excel.Range
        Dim formulasRange As Excel.Range
        Dim targetColIndex As Long
        Dim targetLastRowIndex As Long
        Dim sourceLastRowIndex As Long
        Dim lookupFormula As String
        
        Set wsA = ThisWorkbook.Worksheets("A")
        Set usedRngA = wsA.UsedRange
        
        'Column header.
        targetColIndex = usedRngA.Columns.Count + 1
        wsA.Cells(1, targetColIndex).Value = "added data"
        
        'Formulas.
        targetLastRowIndex = usedRngA.Rows.Count
        sourceLastRowIndex = ThisWorkbook.Worksheets("B").UsedRange.Rows.Count
        'Check if we have anything to work with.
        If targetLastRowIndex > 1 And sourceLastRowIndex > 1 Then
            lookupFormula = "=IFERROR(VLOOKUP(C2,B!$A$2:$C$" & sourceLastRowIndex & ",3,FALSE), ""Not Found"")"
            Set formulasRange = wsA.Range(wsA.Cells(2, targetColIndex), wsA.Cells(targetLastRowIndex, targetColIndex))
            formulasRange.Formula = lookupFormula
        End If
        
        'If desired, eliminate formulas.
        formulasRange.Value = formulasRange.Value
    End Sub