I have attached some sample data that gets updated daily and ends up being 70,000 plus rows after completion of the below code.

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 [SIZE=16px]**40 min **[/SIZE]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 :idea:

- 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