More efficient update macro in Excel

Question

I have a macro that makes comparisons and then this macro exports all of the changes based on if the information doesn't match. I have it so that each column gets their own worksheet in the new workbook. I am using 7 different counting integers and it takes a very long time because I am exporting over 60k rows.

Question: is there a faster way to execute this code? Can a UDF be used? if so how?

Dim ws As Worksheet
Dim wb2 As Workbook
Set wb = Application.Workbooks("Total Database Update_WORKING.xlsm")
Set ws = wb.Worksheets("Results")
Set wb2 = Application.Workbooks.Open("C:\Import Update.xlsx")
    i = 2
    ii = 2
    iii = 2
    iiii = 2
    iiiii = 2
    iiiiii = 2
    iiiiii = 2
    k = 2
    wb2.Activate
    Do While ws.Cells(k, 1) <> ""
        If ws.Cells(k, 4) = "No Match" Then
            wb2.Worksheets("AD UPDATE").Cells(i, 1) = ws.Cells(k, 1)
            wb2.Worksheets("AD UPDATE").Cells(i, 2) = ws.Cells(k, 2)
            i = i + 1
        End If
        If ws.Cells(k, 7) = "No Match" Then
            wb2.Worksheets("SENIOR UPDATE").Cells(ii, 1) = ws.Cells(k, 1)
            wb2.Worksheets("SENIOR UPDATE").Cells(ii, 2) = ws.Cells(k, 5)
            ii = ii + 1
        End If
        If ws.Cells(k, 10) = "No Match" Then
            wb2.Worksheets("ID UPDATE").Cells(iii, 1) = ws.Cells(k, 1)
            wb2.Worksheets("ID UPDATE").Cells(iii, 2) = ws.Cells(k, 8)
            iii = iii + 1
        End If
        If ws.Cells(k, 13) = "No Match" Then
            wb2.Worksheets("MINOR UPDATE").Cells(iiii, 1) = ws.Cells(k, 1)
            wb2.Worksheets("MINOR UPDATE").Cells(iiii, 2) = ws.Cells(k, 11)
        End If
        If ws.Cells(k, 16) = "No Match" Then
            wb2.Worksheets("MAJOR UPDATE").Cells(iiii, 1) = ws.Cells(k, 1)
            wb2.Worksheets("MAJOR UPDATE").Cells(iiii, 2) = ws.Cells(k, 14)
            iiii = iiii + 1
        End If
        If ws.Cells(k, 19) = "No Match" Then
            wb2.Worksheets("CAP UPDATE").Cells(iiiii, 1) = ws.Cells(k, 1)
            wb2.Worksheets("CAP UPDATE").Cells(iiiii, 2) = ws.Cells(k, 17)
            iiiii = iiiii + 1
        End If
        If ws.Cells(k, 22) = "No Match" Then
            wb2.Worksheets("PL UPDATE").Cells(iiiiii, 1) = ws.Cells(k, 1)
            wb2.Worksheets("PL UPDATE").Cells(iiiiii, 2) = ws.Cells(k, 20)
            iiiiii = iiiiii + 1
        End If
        k = k + 1
    Loop

    wb2.Save
    Sleep (1000)
    wb2.Close SaveChanges:=True
    wb.Activate
End Sub

Answer 1

i = 2
ii = 2
iii = 2
iiii = 2
iiiii = 2
iiiiii = 2
iiiiii = 2

Doesn't that smell like... something that doesn't smell good?

You haven't listed the entire module, so this might be a non-issue, from the code you posted but you're not declaring all the variables you're using. Systematically stick an Option Explicit at the top of every module - the code won't run if a non-declared identifier is used anywhere.

Naming things is hard, but bad naming is harmful, and in some cases can reveal structural issues.

When you feel the need to stick a "2" and then a "3" as a suffix to a given identifier, a shiny red flag raises and says you shouldn't be doing that, there has to be a better way... this flag is your subconscious, telling you to split your procedure into multiple, smaller ones.

Let's look at a single block:

    If ws.Cells(k, 4) = "No Match" Then
        wb2.Worksheets("AD UPDATE").Cells(i, 1) = ws.Cells(k, 1)
        wb2.Worksheets("AD UPDATE").Cells(i, 2) = ws.Cells(k, 2)
        i = i + 1
    End If

Several "magic values" can become parameters, if we were to see this repeated code block as a function of its own; the parameters would be:

• { "AD UPDATE", 4, 2 }
• { "SENIOR UPDATE", 7, 5 }
• { "ID UPDATE", 10, 8 }
• { "MINOR UPDATE", 13, 11 }
• { "MAJOR UPDATE", 16, 14 }
• { "CAP UPDATE", 19, 17 }
• { "PL UPDATE, 22, 20 }

Given how these values are used, the corresponding parameter names could be sheetName, matchColumn, and destinationColumn.

i & friends are in fact row counters. This means a method extracted from that code block could look like this:

Private Function SayWhatYouDoDoWhatYouSay(ByRef sourceSheet As Worksheet, _
                                          ByRef destinationBook As Workbook, _
                                          ByVal sheetName As String, _
                                          ByVal sourceRow As Long, _
                                          ByVal matchColumn As Long, _
                                          ByVal destinationColumn As Long, _
                                          ByVal destinationRow As Long) As Long

    Set destinationSheet = destinationBook.Sheets(sheetName)

    If sourceSheet.Cells(sourceRow, matchColumn) = "No Match" Then

        destinationSheet.Cells(destinationRow, 1) = sourceSheet.Cells(sourceRow, 1)
        destinationSheet.Cells(destinationRow, destinationColumn) = sourceSheet.Cells(sourceRow, 2)

        destinationRow = destinationRow + 1

    End If

    SayWhatYouDoDoWhatYouSay = destinationRow

End Function

Notice how sourceRow is much more meaningful than k, and destinationRow than i (or iiiiii); the function returns a new value for destinationRow, which the caller can use to assign a new value for the next destination row.

You could maintain an array of Long (Integer?) values for that:

 Dim destinationRow(0 To 6) As Long

This gives you 7 "slots", one for each update type. To be nice you could give each value a meaningful name as well, with an enum type:

Public Enum UpdateType
    AdUpdate = 0,
    SeniorUpdate,
    IdUpdate,
    MinorUpdate,
    MajorUpdate,
    CapUpdate,
    PlUpdate
End Enum

And then in the original loop, instead of the multiple If blocks:

destinationRow(UpdateType.AdUpdate) = SayWhatYouDoDoWhatYouSay(ws, wb2, "AD UPDATE", k, 4, 2, destinationRow(UpdateType.AdUpdate))
destinationRow(UpdateType.SeniorUpdate) = SayWhatYouDoDoWhatYouSay(ws, wb2, "SENIOR UPDATE", k, 7, 5, destinationRow(UpdateType.SeniorUpdate))
...

Answer 2

What are the chances that more than one of your if statements would be true for each row? It looks like you may risk overwriting some of your data if that is the case.

Dim ws As Worksheet
Dim wb2 As Workbook
Set wb = Application.Workbooks("Total Database Update_WORKING.xlsm")
Set ws = wb.Worksheets("Results")

Using variant your array will be able to size to whatever range you give it, but it will be 1 based.

Dim rng as Variant
Set rng = wb.worksheetS("Results").Range("B2:Your last column/row goes here")
Set wb2 = Application.Workbooks.Open("C:\Import Update.xlsx")
    i = 2
    ii = 2
    iii = 2
    iiii = 2
    iiiii = 2
    iiiiii = 2
    iiiiii = 2
    k = 2
    wb2.Activate
    dim row as long
    dim col as long
    For row = 1 to UBound(rng, 1)
        If rng(row, 4) = "No Match" Then
            wb2.Worksheets("AD UPDATE").Cells(i, 1) = rng(row, 1)
            wb2.Worksheets("AD UPDATE").Cells(i, 2) = rng(row, 2)
            i = i + 1
        End If            
        k = k + 1
    Next Row

    wb2.Save
    Sleep (1000)
    wb2.Close SaveChanges:=True
    wb.Activate
End Sub