Why does VBA run very slow? [closed] - vba

Question

Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 4 years ago.
Improve this question
I have a large excel VBA project that reads in several files and generates a new excel spreadsheet with several tabs. When run with weekly data it takes around 7 minutes to run. When run with monthly data it is taking almost 18 hours to run. It used to take over 30 hours, but thanks to several post on here I have been able to optimize it a lot. I have tried to make the project modular, and I can select which portions of the program I want to run each time it is run. It is the full run that takes the 18 hours. I wrote in a logging capability to see what was taking so long, and have found a portion of the program that takes about 11 hours to run. The issue is, if I select only that portion of the program to run by itself, it only takes 3 minutes to run. During the full run this portion is run later in the full process, so there are several tabs already created before this one is done. When run alone, there are only the two tabs that this portion creates. I'm trying to figure out why there would be such a huge difference in the processing time between running it by itself, and running it in the full process.
I have added the module in question. It's probably not real pretty, but it works. Again, 11 hours when run in the full process and about three minutes when run alone against the same data set.
Thanks,
Sub Upcoming()
Dim Days As Integer
Dim gd_lastrow As Long
'If Logging = True Then
' logIt (" Create new sheet")
'End If
Sheets.Add after:=ActiveSheet
ActiveSheet.Name = "Coming Due"
Range("A1").Value = "IS Code"
Range("B1").Value = "Cage"
Range("C1").Value = "Contractor"
Range("D1").Value = "Contract Number"
Range("E1").Value = "Job #"
Range("F1").Value = "CLIN"
Range("G1").Value = "Due Date"
Range("H1").Value = "RDF"
Range("I1").Value = "Product"
Range("J1").Value = "Qty"
Range("K1").Value = "CA"
Rows("1:1").WrapText = True
Columns("B:B").ColumnWidth = 8
Columns("C:C").ColumnWidth = 46
Columns("D:D").ColumnWidth = 21
Columns("G:G").ColumnWidth = 18
Columns("H:H").ColumnWidth = 18
Columns("I:I").ColumnWidth = 15
Columns("F:F").ColumnWidth = 10
Columns("G:G").ColumnWidth = 21
Columns("K:K").ColumnWidth = 18
Columns("E:F").NumberFormat = "0000"
Columns("E:F").HorizontalAlignment = xlRight
Columns("G:H").NumberFormat = "[$-409]mmmm d, yyyy;#"
up_curline = 2
up_IS = ""
'Sheets("GD").Select
'gd_lastrow = (ActiveSheet.UsedRange.Rows.Count + ActiveSheet.UsedRange.Rows(1).Row) - 1
gd_lastrow = (Sheets("GD").UsedRange.Rows.Count + ActiveSheet.UsedRange.Rows(1).Row) - 1
If myFileExists(myPath & "\GD.xlsx") Then
If Logging = True Then
logIt (" Prep the GD for vLookup")
End If
Sheets("GD").Select
If Range("BF6").Value = "" Then
For i = 6 To gd_lastrow
Range("BF" & i).Value = Range("F" & i).Value & Range("G" & i).Value & Range("T" & i)
Range("BG" & i).Value = Abs(Range("P" & i))
Range("BH" & i).Value = Range("F" & i).Value & Range("G" & i).Value & Range("U" & i)
Range("BI" & i).Value = Abs(Range("P" & i))
Next i
End If
End If
'If Logging = True Then
' logIt (" Get upcoming schedules or RDFs")
'End If
Sheets("DWR").Select
up_lastRow = (ActiveSheet.UsedRange.Rows.Count + ActiveSheet.UsedRange.Rows(1).Row) - 1
For i = 2 To up_lastRow 'Get upcoming RDF's
Sheets("DWR").Select
If Not IsError(Application.Match(Range("C" & i), Worksheets("CAR").Range("C:C"), 0)) Then 'Only get RDF's for the IS's in the CAR
If Not IsError(Application.Match(Range("G" & i), Worksheets("CAR").Range("H:H"), 0)) Then 'Only get RDFs for active contracts
If ((Range("K" & i) >= Now()) And (Range("K" & i) <= Now() + 90) And (Range("AE" & i) = "")) Or _
((Range("Q" & i) >= Now()) And (Range("Q" & i) <= Now() + 90) And (Range("AE" & i) = "")) Or _
((Range("AE" & i) >= Now()) And (Range("AE" & i) <= Now() + 90)) Then
Worksheets("Coming Due").Range("A" & up_curline) = Range("C" & i) 'IS
Worksheets("Coming Due").Range("B" & up_curline) = Range("E" & i) ' Cage
Worksheets("Coming Due").Range("C" & up_curline) = Range("D" & i) 'Contractor
Worksheets("Coming Due").Range("D" & up_curline) = Range("G" & i) ' Contract #
Worksheets("Coming Due").Range("F" & up_curline) = Range("J" & i) ' CLIN
If (Range("K" & i) = 0) Then
Worksheets("Coming Due").Range("G" & up_curline) = Range("Q" & i)
Sheets("Coming Due").Select
Range("H" & up_curline).Select
'Sheets("Coming Due").Range("H" & up_curline).ThemeColor = xlThemeColorDark1
'Sheets("Coming Due").Range("H" & up_curline).TintAndShade = -0.249977111117893
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
Sheets("DWR").Select
Else
Worksheets("Coming Due").Range("G" & up_curline) = Range("K" & i) ' Due Date
End If
If Worksheets("Coming Due").Range("H" & up_curline) <> "Service CLIN" Then
Worksheets("Coming Due").Range("H" & up_curline) = Range("AE" & i) ' RDF
End If
If ((Worksheets("Coming Due").Range("H" & up_curline) = "") Or (Worksheets("Coming Due").Range("H" & up_curline)) = "Service CLIN") Then
Worksheets("Coming Due").Range("G" & up_curline).Style = "Neutral"
Else
Worksheets("Coming Due").Range("H" & up_curline).Style = "Neutral"
End If
'Worksheets("Coming Due").Range("I" & up_curline) = Range("V" & i) ' Item
If ((Range("N" & i) > 0) And (Range("N" & i) = Range("O" & i))) Then
Worksheets("Coming Due").Range("J" & up_curline) = "Shipped"
Else
'Worksheets("Coming Due").Range("J" & up_curline) = Range("N" & i) - Range("O" & i) ' Qty
On Error Resume Next
Err.Clear
Worksheets("Coming Due").Range("J" & up_curline) = Application.WorksheetFunction.VLookup(Worksheets("DWR").Range("G" & i).Value & format(Worksheets("DWR").Range("J" & i), "0000") & Worksheets("DWR").Range("K" & i), Worksheets("GD").Range("BF6:BG" & gd_lastrow), 2, 0)
If Err.Number <> 0 Then
Err.Clear
Worksheets("Coming Due").Range("J" & up_curline) = Application.WorksheetFunction.VLookup(Worksheets("DWR").Range("G" & i).Value & Worksheets("DWR").Range("J" & i) & Worksheets("DWR").Range("K" & i), Worksheets("GD").Range("BF6:BG" & gd_lastrow), 2, 0)
If Err.Number <> 0 Then
Err.Clear
Worksheets("Coming Due").Range("J" & up_curline) = Application.WorksheetFunction.VLookup(Worksheets("DWR").Range("G" & i).Value & format(Worksheets("DWR").Range("J" & i), "0000") & Worksheets("DWR").Range("K" & i), Worksheets("GD").Range("BH6:BI" & gd_lastrow), 2, 0)
If Err.Number <> 0 Then
Err.Clear
Worksheets("Coming Due").Range("J" & up_curline) = Application.WorksheetFunction.VLookup(Worksheets("DWR").Range("G" & i).Value & Worksheets("DWR").Range("J" & i) & Worksheets("DWR").Range("K" & i), Worksheets("GD").Range("BH6:BI" & gd_lastrow), 2, 0)
If Err.Number <> 0 Then
If Logging = True Then
logIt (" VlookUp Still Not Found")
logIt (" " & Err.Number & ": " & Err.Description)
logIt (" i = " & i)
logIt (" Contract = " & Worksheets("DWR").Range("G" & i).Value)
logIt (" CLIN = " & format(Worksheets("DWR").Range("J" & i), "0000"))
logIt (" Schedule Date = " & Worksheets("DWR").Range("K" & i))
logIt (" Lookup Value = " & Worksheets("DWR").Range("G" & i).Value & format(Worksheets("DWR").Range("J" & i), "0000") & Worksheets("DWR").Range("K" & i))
End If
End If
End If
End If
End If
On Error GoTo 0
End If
For o = 0 To 2000
If CDRLdata(o).contract = Worksheets("Coming Due").Range("D" & up_curline) Then
Worksheets("Coming Due").Range("E" & up_curline) = CDRLdata(o).job
Worksheets("Coming Due").Range("I" & up_curline) = CDRLdata(o).Product
Exit For
End If
Next o
up_curline = up_curline + 1
End If
End If
End If
Next i
Sheets("Coming Due").Select
up_lastRow = (ActiveSheet.UsedRange.Rows.Count + ActiveSheet.UsedRange.Rows(1).Row) - 1
'If Logging = True Then
' logIt (" Get service CLIN data")
'End If
Sheets("GD").Select 'Get service CLINs qty due
gd_lastrow = (ActiveSheet.UsedRange.Rows.Count + ActiveSheet.UsedRange.Rows(1).Row) - 1
For j = 2 To up_lastRow
If Worksheets("Coming Due").Range("J" & j) = 0 Then
For i = 6 To gd_lastrow
If ((Range("F" & i) = Worksheets("Coming Due").Range("D" & j)) And (Range("G" & i) = Worksheets("Coming Due").Range("F" & j)) And (Range("W" & i) = Worksheets("Coming Due").Range("G" & j))) Then
If ((Range("H" & i) > 0) And (Range("H" & i) = Range("I" & i))) Then
Worksheets("Coming Due").Range("J" & j) = "Shipped"
Else
Worksheets("Coming Due").Range("J" & j) = Range("H" & i) - Range("I" & i)
End If
End If
Next i
End If
Next j
For j = 2 To up_lastRow
If Worksheets("Coming Due").Range("J" & j) = "Shipped" Then
For i = 6 To gd_lastrow
If ((Range("F" & i) = Worksheets("Coming Due").Range("D" & j)) And (Range("G" & i) = Worksheets("Coming Due").Range("F" & j)) And (Range("U" & i) = Worksheets("Coming Due").Range("G" & j))) Then
If ((Range("N" & i) > 0) And (Range("N" & i) = Range("O" & i))) Then
Worksheets("Coming Due").Range("J" & j) = "Shipped"
Else
Worksheets("Coming Due").Range("J" & j) = Range("N" & i) - Range("O" & i)
End If
End If
Next i
End If
Next j
' Add any comments
'If Logging = True Then
' logIt (" Add comments to the list")
'End If
Dim tCLIN As String
Sheets("Coming Due").Select
commenttext = ""
cd_lastrow = (ActiveSheet.UsedRange.Rows.Count + ActiveSheet.UsedRange.Rows(1).Row) - 1
For r = 2 To cd_lastrow
For p = 0 To 2000
If CDRLdata(p).company = "" Then
Exit For
End If
' Contract level
If ((CDRLdata(p).contract = Worksheets("Coming Due").Range("D" & r)) And (CDRLdata(p).CoNotes <> "")) Then
commenttext = CDRLdata(p).contract & ": " & CDRLdata(p).CoNotes
temp2 = "D" & r
Set mycomment = Range(temp2).Comment
If mycomment Is Nothing Then
Range(temp2).AddComment
Range(temp2).Comment.Visible = False
Range(temp2).Comment.Text commenttext
Range(temp2).Comment.Shape.TextFrame.AutoSize = True
End If
End If
' CLIN Level
If CDRLdata(p).contract = Worksheets("Coming Due").Range("D" & r) Then
If Len(Worksheets("Coming Due").Range("F" & r)) = 1 Then
tCLIN = "000" & Worksheets("Coming Due").Range("F" & r)
Else
If Len(Worksheets("Coming Due").Range("F" & r)) = 2 Then
tCLIN = "00" & Worksheets("Coming Due").Range("F" & r)
Else
If Len(Worksheets("Coming Due").Range("F" & r)) = 3 Then
tCLIN = "0" & Worksheets("Coming Due").Range("F" & r)
Else
tCLIN = Worksheets("Coming Due").Range("F" & r)
End If
End If
End If
If ((CDRLdata(p).CLIN = tCLIN) And (tCLIN <> "")) Then
If CDRLdata(p).CdNotes <> "" Then
commenttext = CDRLdata(p).contract & " CLIN " & CDRLdata(p).CLIN & ": "
If CDRLdata(p).di <> "" Then
commenttext = commenttext & CDRLdata(p).di & " "
End If
commenttext = commenttext & CDRLdata(p).CdNotes
For q = p + 1 To 2000
If ((CDRLdata(q).contract = Worksheets("Coming Due").Range("D" & r)) And (CDRLdata(q).CLIN = Worksheets("Coming Due").Range("F" & r)) And (CDRLdata(q).CdNotes <> "")) Then
commenttext = commenttext & " " & " CLIN " & CDRLdata(q).CLIN & ": "
If CDRLdata(q).di <> "" Then
commenttext = commenttext & CDRLdata(q).di & " "
End If
commenttext = commenttext & CDRLdata(q).CdNotes
End If
Next q
temp2 = "F" & r
Set mycomment = Range(temp2).Comment
If mycomment Is Nothing Then
Range(temp2).AddComment
Range(temp2).Comment.Visible = False
Range(temp2).Comment.Text commenttext
Range(temp2).Comment.Shape.TextFrame.AutoSize = True
End If
Exit For
End If
End If
End If
Next p
Next r
'If Logging = True Then
' logIt (" Format comments")
'End If
Comments_Tom
'If Logging = True Then
' logIt (" Sort table by IS, Cage, Due date, Contract and CLIN")
'End If
Sheets("Coming Due").Select
up_lastRow = (ActiveSheet.UsedRange.Rows.Count + ActiveSheet.UsedRange.Rows(1).Row) - 1
For i = 2 To up_lastRow
If Range("H" & i) = "" Then
Range("M" & i) = Range("G" & i)
Else
If Range("H" & i) = "Service CLIN" Then
Range("M" & i) = Range("G" & i)
Else
Range("M" & i) = Range("H" & i)
End If
End If
Next
For i = 2 To up_lastRow
For p = 0 To 2000
' Get CA Name
If CDRLdata(p).contract = Worksheets("Coming Due").Range("D" & i) Then
If CDRLdata(p).Position1 = "Contract Administrator" Then
Range("K" & i) = CDRLdata(p).Name1
Else
If CDRLdata(p).Position2 = "Contract Administrator" Then
Range("K" & i) = CDRLdata(p).Name2
Else
If CDRLdata(p).Position3 = "Contract Administrator" Then
Range("K" & i) = CDRLdata(p).Name3
End If
End If
End If
Exit For
End If
Next p
Next i
'sort by IS, Cage, Due date, Contract, CLIN
Range("A2:M" & up_lastRow).Select
ActiveWorkbook.Worksheets("Coming Due").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Coming Due").Sort.SortFields.Add Key:=Range( _
"A2:A" & up_lastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Coming Due").Sort.SortFields.Add Key:=Range( _
"B2:B" & up_lastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
ActiveWorkbook.Worksheets("Coming Due").Sort.SortFields.Add Key:=Range( _
"M2:M" & up_lastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Coming Due").Sort.SortFields.Add Key:=Range( _
"D2:D" & up_lastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Coming Due").Sort.SortFields.Add Key:=Range( _
"F2:F" & up_lastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Coming Due").Sort
.SetRange Range("A1:M" & up_lastRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWorkbook.Save
' enter 30/60/90 day group headers
If Logging = True Then
logIt (" Enter 30/60/90 day headers")
End If
Sheets("Coming Due").Select
Range("A2").Select
up_curline = 2
up_IS = Range("A2")
up_cage = Range("B2")
up_Contract = Range("C2")
up_Due = Range("G2")
up_RDF = Range("H2")
up_Due = 0
up_RDF = 0
Rows("2:4").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
up_lastRow = up_lastRow + 3
up_curline = up_curline + 3
If ((Range("G" & up_curline) <= Now() + 30) And (Range("H" & up_curline) = "")) Then
Range("D" & up_curline - 2).Value = "Due within 30 days"
Days = 30
Else
If ((Range("G" & up_curline) <= Now() + 60) And (Range("H" & up_curline) = "")) Then
Range("D" & up_curline - 2).Value = "Due within 60 days"
Days = 60
Else
If Range("H" & up_curline) = "" Then
Range("D" & up_curline - 2).Value = "Due within 90 days"
Days = 90
End If
End If
End If
If (Range("H" & up_curline) <> "") Then
If Range("H" & up_curline) <= Now() + 30 Then
Range("D" & up_curline - 2).Value = "Due within 30 days"
Days = 30
Else
If Range("H" & up_curline) <= Now() + 60 Then
Range("D" & up_curline - 2).Value = "Due within 60 days"
Days = 60
Else
Range("D" & up_curline - 2).Value = "Due within 90 days"
Days = 90
End If
End If
End If
i = up_curline
Do Until IsEmpty(Cells(i, 1))
If Range("B" & i) <> up_cage Then
up_cage = Range("B" & i)
Rows(i & ":" & i + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
up_lastRow = up_lastRow + 3
i = i + 3
If ((Range("G" & i) <= Now() + 30) And ((Range("H" & i) = "")) Or _
(((Range("H" & i) <> "")) And (Range("H" & i) <= Now() + 30))) Then
Range("D" & i - 2).Value = "Due within 30 days"
Days = 30
Else
If ((Range("G" & i) <= Now() + 60) And ((Range("H" & i) = "")) Or _
(((Range("H" & i) <> "")) And (Range("H" & i) <= Now() + 60))) Then
Range("D" & i - 2).Value = "Due within 60 days"
Days = 60
Else
Range("D" & i - 2).Value = "Due within 90 days"
Days = 90
End If
End If
End If
If (Days = 30) And _
(((Range("G" & i) > Now() + 30) And (Range("G" & i) <= Now + 60) And (Range("H" & i) = "")) Or _
((Range("H" & i) > Now() + 30) And (Range("H" & i) <= Now + 60) And (Range("H" & i) <> ""))) Then
Days = 60
Rows(i & ":" & i + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
up_lastRow = up_lastRow + 3
i = i + 3
Range("D" & i - 2).Value = "Due within 60 days"
End If
If (Days = 30) And _
(((Range("G" & i) > Now() + 60) And (Range("G" & i) <= Now + 90) And (Range("H" & i) = "")) Or _
((Range("H" & i) > Now() + 60) And (Range("H" & i) <= Now + 90) And (Range("H" & i) <> ""))) Then
Days = 90
Rows(i & ":" & i + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
up_lastRow = up_lastRow + 3
i = i + 3
Range("D" & i - 2).Value = "Due within 90 days"
End If
If (Days = 60) And _
(((Range("G" & i) > Now() + 60) And (Range("G" & i) <= Now + 90) And (Range("H" & i) = "")) Or _
((Range("H" & i) > Now() + 60) And (Range("H" & i) <= Now + 90) And (Range("H" & i) <> ""))) Then
Days = 90
Rows(i & ":" & i + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
up_lastRow = up_lastRow + 3
i = i + 3
Range("D" & i - 2).Value = "Due within 90 days"
End If
i = i + 1
Loop
Columns("M:M").Delete
For i = 5 To up_lastRow
If Left(Range("D" & i), 10) = "Due within" Then
Range("G" & i - 1 & ":H" & i + 1).Style = "Normal"
End If
Next
Sheets("Coming Due").Select
ActiveCell.ClearComments
Range("A2").Select
ActiveWindow.FreezePanes = True
ActiveSheet.Name = "30-60-90 By Date"
up_lastRow = (ActiveSheet.UsedRange.Rows.Count + ActiveSheet.UsedRange.Rows(1).Row) - 1
Range("A1:K" & up_lastRow).Borders.LineStyle = xlContinuous
ActiveWorkbook.Save
' Create the 30-60-90 by Contract Tab
If Logging = True Then
logIt ("Begin Upcoming By Contract")
End If
Dim curCage As String
Dim curContract As String
Range("A1:K" & up_lastRow).Select
Selection.Copy
Sheets.Add
ActiveSheet.Name = "30-60-90 By Contract"
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveSheet.Paste
Application.CutCopyMode = False
If Logging = True Then
logIt (" Begin Sorting By Contract")
End If
ActiveWorkbook.Worksheets("30-60-90 By Contract").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("30-60-90 By Contract").Sort.SortFields.Add Key:= _
Range("B5:B" & up_lastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
ActiveWorkbook.Worksheets("30-60-90 By Contract").Sort.SortFields.Add Key:= _
Range("D5:D" & up_lastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
ActiveWorkbook.Worksheets("30-60-90 By Contract").Sort.SortFields.Add Key:= _
Range("G5:G" & up_lastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets("30-60-90 By Contract").Sort
.SetRange Range("A5:K" & up_lastRow)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Rows("3:4").Delete Shift:=xlUp
If Logging = True Then
logIt (" Begin Deleting Blank Rows")
End If
For i = up_lastRow - 2 To 1 Step -1
If Range("A" & i).Value = "" Then
Rows(i & ":" & i).Delete Shift:=xlUp
Else
up_lastRow = i
Exit For
End If
If ((i Mod 200) = 0) Then
If Logging = True Then
logIt (" Line =" & i)
End If
End If
Next i
Range("A2").Select
ActiveWindow.FreezePanes = True
curCage = Range("B3").Value
curContract = Range("D3").Value
j = 4
If Logging = True Then
logIt (" Begin Looking For New CAGE or Contract Number")
End If
While Range("A" & j).Value <> ""
If Range("B" & j).Value <> curCage Then
curCage = Range("B" & j).Value
curContract = Range("D" & j).Value
Rows(j & ":" & j + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
j = j + 2
End If
If Range("D" & j).Value <> curContract Then
curContract = Range("D" & j).Value
Rows(j & ":" & j).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
j = j + 1
End If
j = j + 1
If ((j Mod 200) = 0) Then
If Logging = True Then
logIt (" Line =" & j)
End If
End If
Wend
End Sub

Answer 1

the VBA is kind of like Java which runs on JVM it is not really the CPU that does run it.
for example, consider the game speed when you would emulate PS3 on PC/Mac rather than using the real device (in short very slow).
what mean's VBA is already very slow and now your code does run on Excel and that will further slow everything since it will wait for Excel view/update.
my choice would be to rewrite your code using Qt and QtXlsxWriter.
although changing from VBA to C++ was a great step for me but the Qt libraries where/are even more clear to understand as VBA.
another option would be to provide your code so we see what is the problem but it looks like that is not an option ;-)
without the code's I think it has to do with VBA waiting for Excel update

Answer 2

I have pretty much solved my problem, but still do not have an answer to my question. I now have the monthly run being completed in less than 4 hours, and still see where other optimizations can be made. I primarily made three changes. First, I put in Application.Calculation = xlCalculationManual at the beginning of the module that was taking so long, and set it back to automatic at the end of the module. This cut the 11 hours down to around 4 to 5 hours. I had read a lot on optimization, but the comment above was the first time I had heard of this. Next I moved this module up to the beginning of the run. Recall that running this module later in the full run took 11 hours, but when run alone, it only took around three minutes. When run as the first module, in the full run it just takes three to four minutes. And finally, I rewrote the module to use 2D array instead of inserting and deleting rows and columns in the worksheets. The module now takes around 1 minute. From 11 + hours to 1 minute is pretty good I'm thinking. But the question is still there. Why did moving the module from later in the run to first cause such a big difference, especially when recalc was set to manual. Is it memory management? Is it ????? I dunno, but I'm very happy with the results.