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

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.