1
\$\begingroup\$

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
\$\endgroup\$
1
  • 2
    \$\begingroup\$ 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? \$\endgroup\$
    – PeterT
    Oct 6, 2016 at 17:55

1 Answer 1

1
\$\begingroup\$

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.

  1. Variable names - give your variables meaningful names.

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

  3. 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.

\$\endgroup\$
2
  • \$\begingroup\$ 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. \$\endgroup\$ Oct 7, 2016 at 10:01
  • 1
    \$\begingroup\$ 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. \$\endgroup\$ Oct 7, 2016 at 11:34

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.