The macro below essentially inserts rows for missing dates and copies values down to those rows. After all the rows are inserted the macro will then insert formulas into columns so that calculate max/min and week number for displaying later. This data is refreshed via SQL call every day and the code is then run to complete the missing data.

Currently this macro takes

**40 min**to run and I have exhausted all of my knowledge on how to speed it up. I have read that it may be faster to use arrays and or variant to perform looping inserts like below but I just don't have any experience with this method and cant figure it out. Lastly I know there are some "Volatile" functions that should be avoided but I am not sure exactly how many I am using and how to avoid them. At this point I would be open to any ideas on how to speed this up.

Thank you all for any ideas

Code:

Sub FillDates() Dim StartRow, CurrRow, ct As Long Dim CurrDate, PrevDate, DateDiff As Long Dim CurrPriceID, PrevPriceID As Long Application.Calculation = xlCalculationManual Application.ScreenUpdating = False Application.DisplayStatusBar = False Application.DisplayAlerts = False Application.EnableEvents = False Sheets("PriceData").Select 'Initialize row counters StartRow = 2 CurrRow = StartRow Do While Range("A" & CurrRow).Value <> "" 'Determine if this is the first row If CurrRow = StartRow Then Else CurrDate = Range("E" & CurrRow).Value CurrPriceID = Range("F" & CurrRow).Value PrevDate = Range("E" & CurrRow - 1).Value PrevPriceID = Range("F" & CurrRow - 1).Value DateDiff = CurrDate - PrevDate 'Determine if you are still on the same PriceID If CurrPriceID = PrevPriceID Then 'Determine if the year starts on the second day or not, if not than make it start on the 2nd If Year(Range("E" & CurrRow - 1).Value) < Year(Range("E" & CurrRow).Value) Then If Month(Range("E" & CurrRow).Value) = 1 And Day(Range("E" & CurrRow)) > 2 Then Rows(CurrRow & ":" & CurrRow + DateDiff - 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove ct = 1 Do While ct < DateDiff Range("A" & CurrRow & ":I" & CurrRow).Value = Range("A" & CurrRow - 1 & ":I" & CurrRow - 1).Value Range("E" & CurrRow).Value = Range("E" & CurrRow - 1).Value + 1 ct = ct + 1 CurrRow = CurrRow + 1 Loop End If CurrDate = Range("E" & CurrRow).Value PrevDate = Range("E" & CurrRow - 1).Value DateDiff = CurrDate - PrevDate End If 'Determine if there is a gap between the days. If the gap is less than 1 week, fill in the gap If DateDiff > 1 And DateDiff < 7 Then Rows(CurrRow).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Range("A" & CurrRow & ":I" & CurrRow).Value = Range("A" & CurrRow - 1 & ":I" & CurrRow - 1).Value Range("E" & CurrRow).Value = Range("E" & CurrRow - 1).Value + 1 Else End If If Range("E" & CurrRow).Value + 1 = Date Then 'creates place holder dates to hold max and min values for current year range Do While Month(Range("E" & CurrRow).Value) > 1 Rows(CurrRow + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Range("A" & CurrRow + 1 & ":F" & CurrRow + 1).Value = Range("A" & CurrRow & ":F" & CurrRow).Value Range("E" & CurrRow + 1).Value = Range("E" & CurrRow).Value + 1 CurrRow = CurrRow + 1 Loop 'to delete the january of next year line added at end of loop Rows(CurrRow).Delete End If Else End If End If CurrRow = CurrRow + 1 Loop 'Force the year to be 2000 to ensure week numbers line up from year to year Range("B2").Formula = "=IfError(WEEKNUM(MONTH([@Date]) & ""/"" & DAY([@Date]) & ""/"" & YEAR(""1/1/2000"")),"""")" Range("B2").AutoFill Destination:=Range("B2" & ":B" & CurrRow) Range("H2").Formula = "=IfError(MINIFS([SettlePrice],[Week],[@Week],[Price ID],[@[Price ID]]),"""")" Range("H2").AutoFill Destination:=Range("H2" & ":H" & CurrRow) Range("I2").Formula = "=IfError(MAXIFS([SettlePrice],[Week],[@Week],[Price ID],[@[Price ID]]),"""")" Range("I2").AutoFill Destination:=Range("I2" & ":I" & CurrRow) Calculate Application.Calculation = xlCalculationManual Application.ScreenUpdating = True Application.DisplayStatusBar = True Application.DisplayAlerts = True Application.EnableEvents = True End Sub

## Leave a comment: