# 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(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

• One thing you could do to speed up looping would be dump your sheet into an array and loop that. – Zaider Mar 25 '14 at 13:46
• I tried that but I keep getting Object not defined when I try to use a range in an array. Is there a specific way to do that? – user3271518 Mar 25 '14 at 13:49

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
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))
...


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