Collect data from 4+ columns and insert data into another column

Question

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

• PeterT: An immediate and huge performance speed up can be achieved by moving your processing to a memory array. Do you have a sample of your data you can share?

Answer 1

Variables

I don't see any of your variables defined. (That's like blasphemy here)

1. Always turn on Option Explicit. You can have it automatically by going to Tools -> Options in the VBE and checking the Require Variable Declaration option. This way if you have any variables not defined, the compiler will let you know.

2. When you don't define your variable, VBA will declare it as a Variant, which are objects:

Performance. A variable you declare with the Object type is flexible enough to contain a reference to any object. However, when you invoke a method or property on such a variable, you always incur late binding (at run time). To force early binding (at compile time) and better performance, declare the variable with a specific class name, or cast it to the specific data type.

By not declaring variables, you could possibly be paying a penalty.

3. Variable names - give your variables meaningful names.

4. Standard VBA naming conventions have camelCase for local variables and PascalCase for other variables and names.

5. Since you have something like irow, I'll just throw this in as well - Integers - integers are obsolete. According to msdn VBA silently converts all integers to long.

---

Your function

 Function findcol(Text)

Should be

Private Function LocateColumnByName(ByVal columnName As String) As Long
 Const SEARCH_ROW As Long = 9
 Dim foundColumn As Long
 On Error GoTo errHandler
 foundColumn = Sheet1.Cells(SEARCH_ROW, 1).EntireRow.Find(What:=columnName, LookIn:=xlValues, lookat:=xlPart).Column
 LocateColumnByName = foundColumn
 Exit Function
errHandler:
 MsgBox "Error : '" & columnName & "' column not found. Please report this error to the global team"
End Function

You'll need to handle the return of nothing in the main sub, or have the error assign 0 and handle that.

• Fitnessguru: Do you suggest I rewrite this again? Or are there actionable tweaks that I can do to make this run faster. Please state a step plan to move forward. Thank you.
• Raystafarian: Something that's great about codereview is that teamwork is important - some users may address some parts of the code and others different parts. All parts of the code are up for review. I chose to discuss variables and your function, but perhaps someone else might come along and focus on methods. You can always use my advice to clean up the code and wait for another answer, or post a follow-up with the improvements.