I have a macro which seriously needs to optimised. I have changed the nested loop, but it takes off only a few minutes. The entire macro runs for about 14 minutes. I think the logic needs to be changed? Or perhaps I am missing something completely.I thought about hard coding the columns. But the data columns are updated regularly, so hard coding the columns will NOT be useful. Same logic applies to a dictionary.
The code is designed to take data from Region, Station, Nutrition, Time etc... columns and insert the data into the Schedule column. It looks up the data row by row (over 50,000 rows). If I filter the Schedule column (in the data book), 10,000 of those rows are blank "-", which means, the loop is looping more than it should,as there are over 50,00 rows, hence its taking more time. I cant figure out away to stop the extra loops and still insert the data in the Schedule column.
Help will be appreciated.
Sub ScheduleZone()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Sheets("Training Data").Select
irow = 15
If Range("B2").Value = "ClientPlan" Then
RegionCol = findcol("Chest Region")
Else
RegionCol = findcol("Arm Region")
End If
stationcol = findcol("Leg")
While Cells(irow, stationcol) <> ""
irow = irow + 1
Wend
itotalrows = irow - 11
NutitionalBuyCol = findcol("Nutritional Buy")
TimeCol = findcol("Time (HH.MM.SS)")
ScheduleCol = findcol("Schedule")
ClientCol = findcol("Client Analysis")
If Sheets("Template Menu").Range("G5") = "1" Then
facebookcol = findcol("Facebook Audience ")
Else
facebookcol = findcol("Facebook Target Audience")
End If
‘Main work begins here
irow = 10
While Cells(irow, stationcol) <> ""
Status = ((irow - 10) / itotalrows)
SuccessIndicator.Txtstatusbox1 = Format(Status, "0%")
DoEvents
Region = Cells(irow, RegionCol)
Station = Cells(irow, stationcol)
Facebook = Cells(irow, facebookcol)
Nutrition = Cells(irow, NutitionalBuyCol l)
Time = Cells(irow, TimeCol)
Client = Cells(irow, ClientCol)
If Client = "Yes" Or Client = "Y" Then
Sheets("GymClass").Select
irow2 = 10
iFound = 0
If Sheets("Template Menu").Range("G11") = "1" Then
icol = 120
x = 2
ElseIf Sheets("Template Menu").Range("G11") = "2" Then
icol = 100
x = 1
End If
While Cells(irow2, icol) <> "" And iFound = 0
If Sheets("Template Menu").Range("G45") = "1" Then
If Cells(irow2, icol) = Facebook And Cells(irow2, icol + 4) <= Time And Cells(irow2, icol + 5) > Time Then
iFound = 1
Schedule = Cells(irow2, icol + 3)
ElseIf Cells(irow2, icol) = Facebook And x = 2 Then
iFound = 1
Schedule = "No Attendance"
End If
Else
If Cells(irow2, icol - 2) = Region And Cells(irow2, icol - 1) = Station And Cells(irow2, icol) = Facebook And Cells(irow2, icol + 1) = Nutrition And Cells(irow2, icol + 4) <= Time And Cells(irow2, icol + 5) > Time Then
iFound = 1
DPAbv = Cells(irow2, icol + 3)
ElseIf Cells(irow2, icol - 2) = Region And Cells(irow2, icol - 1) = Station And Cells(irow2, icol) = Facebook And Cells(irow2, icol + 1) = Nutrition And x = 2 Then
iFound = 1
Schedule = "No Attendance"
End If
End If
irow2 = irow2 + 1
Wend
If iFound = 0 Then Schedule = "-"
Sheets("Training Data ").Select
Else
Schedule = "-"
End If
Cells(irow, ScheduleCol ) = Schedule
irow = irow + 1
Wend
SuccessIndicator.Txtstatusbox1 = "Finished"
DoEvents
Application.Calculation = xlCalculationAutomatic
Workbooks("Master File.xlsm").Close
End Sub
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Function findcol(Text)
'**********************************************
'********* Does not unhide columns ************
'**********************************************
'If ActiveWorkbook.Name <> "Test Findcol.xlsm" Then
' Columns("A:CC").EntireColumn.Hidden = False
' Range("A9").Select
' Cells.Find(Text, ActiveCell, xlValues, xlWhole, xlByColumns, xlNext, False, False).Activate
' findcol = ActiveCell.Column
'Else
' MsgBox ("Running new findcol")
icol = 1
While Cells(9, icol) <> Text And icol < 150
icol = icol + 1
Wend
If icol = 150 Then MsgBox ("Error : '" & Text & "' column not found. Please report this error to the global team")
findcol = icol
'End If
End Function