I have a worksheet change event that, when 3 adjacent cells are filled in columns C,D and E it is documented in a different sheet with the date as well as the sheet that where the cells have been filled in.
Then every occurrence of date data is summed up and plotted on a calendar essentially showing how many entries have occurred for everyday of the year.
The issue is, is that the code loops through all days of the year which makes it incredibly slow, is there any way to make adjustments so it doesn't loop through everything or at least to speed up the process?
This is the code for the loops in question:
With Sheets("Log")
Set dfCell = dws.Cells(dws.Rows.Count, dCol) _
.End(xlUp).Offset(1)
dfCell.Value = Format(Date, "mm/dd/yyyy")
dfCell.Offset(, 1).Value = ActiveSheet.Name
dfCell.Offset(, 2).Value = srAddress
Dim arrDates As Range
Dim LastRow As Long
Dim DateRange As Long
Dim RowCount As Long
Dim ClmnAmnt As Long
Dim ClmnDate() As Variant
Dim AddrArr() As Variant
Dim ClmnNmbr As Long
Dim shtNames As Range
Dim TypCount As Long
Dim FrstLetter() As Variant
Dim SheetIdent As String
Dim lastAddrs As String
For RowCount = 1 To 60
Select Case RowCount
Case 2, 7, 12, 17, 22, 27, 32, 37, 42, 47, 52, 57
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
DateRange = WorksheetFunction.CountA(.Range("F" & RowCount & ":AJ" & RowCount))
For TypCount = 1 To 3
SheetIdent = .Cells(RowCount + TypCount, 5).Value
For ClmnNmbr = 1 To DateRange
ReDim AddrArr(DateRange)
AddrArr(ClmnNmbr) = .Cells(RowCount, ClmnNmbr + 5).Value
Set arrDates = .Range("A60:A" & LastRow)
Set shtNames = .Range("B60:B" & LastRow)
ReDim FrstLetter(DateRange)
FrstLetter(ClmnNmbr) = Application.CountIfs(arrDates, AddrArr(ClmnNmbr), shtNames, SheetIdent)
Worksheets("Log").Cells(TypCount + RowCount, ClmnNmbr + 5).Value = Application.Transpose(FrstLetter(ClmnNmbr))
Next ClmnNmbr
Next TypCount
Case Else
End Select
Next RowCount
End With
For RowCount = 2 To 57 Step 5
, setLastRow
outside your loop – cybernetic.nomadApplication.ScreenUpdating
while the macro is running, set toFalse
at the start of the loop andTrue
at the end. Also, since you're making changes to the sheet, you can temporarily disable sheet recalculations as well withApplication.Calculation = xlCalculationManual
. Don't forget to set it back to auto (xlCalculationAutomatic
). These two things should improve the execution speed by a large amount. – Toddleson