More efficient update macro in Excel

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(

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

StackExchange Code Review Q#45249, answer score: 4