CODEWITHSUNDEEP
vbaexcel
Cocoberry2526
Cocoberry2526

Reputation: 187

Ways to speed up code with multiple IF statements

I've been working on this code all day and have finally gotten everything to work perfectly. The only problem, is that the code does run pretty slow. Considering that it will be used on a workbook with thousands of rows I would like to change that. I am extremely new to vba so there is probably stuff in here that is wrong or seems like a bad shortcut. I think I added a couple of ways that could speed it up but i didnt know if anything else could be done. 

 Sub Degree_Workboook_Names_major1()

 Application.ScreenUpdating = False
 Application.DisplayStatusBar = False
 Application.EnableEvents = False

'Inserts a new column after column H named department names
 range("I1").EntireColumn.Insert
 range("I1").Value = "DeptName"


 Dim abbrRange As range              'range to hold the columns with the department names
 Set abbrRange = range("H:H")

'Writes the department name in the the department name column next to the associated abbr

 For Each cell In abbrRange


            If cell.Value = "ACC" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Accounting"
            End If

            If cell.Value = "ACS" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Adolescent, Career and Special Education"
            End If

            If cell.Value = "AES" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Animal and Equine Science"
            End If

            If cell.Value = "AGR" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Agricultural Science"
            End If

            If cell.Value = "AHS" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Applied Health Sciences"
            End If

            If cell.Value = "AHT" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Veterinary Technology and Pre-Veterinary Medicine"
            End If

            If cell.Value = "Art" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Art and Design"
            End If

            If cell.Value = "BIO" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Biology"
            End If

            If cell.Value = "BPA" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Management, Marketing and Business Administration"
            End If

            If cell.Value = "CCD" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Center for Communication Disorders"
            End If

            If cell.Value = "CEAO" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Bachelor of Integrated Studies Program"
            End If

            If cell.Value = "CHE" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Chemistry"
            End If

            If cell.Value = "CLH" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Community Leadership and Human Services"
            End If

            If cell.Value = "COM" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Organizational Communication"
            End If

            If cell.Value = "CSC" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Computer Science and Information Systems"
            End If

            If cell.Value = "ECO" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Economics and Finance"
            End If

            If cell.Value = "ELE" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Early Childhood and Elementary Education"
            End If

            If cell.Value = "ENPH" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of English and Philosophy"
            End If

            If cell.Value = "ELSC" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Educational Studies, Leadership and Counseling"
            End If

            If cell.Value = "GSC" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Geosciences"
            End If

            If cell.Value = "HFA" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Liberal Arts"
            End If

            If cell.Value = "HIS" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of History"
            End If

            If cell.Value = "INDC" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Institute of Engineering"
            End If

            If cell.Value = "IOE" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Institute of Engineering"
            End If

            If cell.Value = "JMC" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Journalism and Mass Communications"
            End If

            If cell.Value = "MAT" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Mathematics and Statistics"
            End If

            If cell.Value = "MLA" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Modern Languages"
            End If

            If cell.Value = "MMB" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Management, Marketing and Business Administration"
            End If

            If cell.Value = "MSP" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Military Science Program"
            End If

            If cell.Value = "MUS" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Music"
            End If

            If cell.Value = "NUR" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Nursing"
            End If

            If cell.Value = "OSH" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Occupational Safety and Health"
            End If

            If cell.Value = "POL" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Political Science and Sociology"
            End If

            If cell.Value = "PSY" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Psychology"
            End If

            If cell.Value = "THR" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Theatre"
            End If

 Next



 'Inserts a new column after column H named department names
range("M1").EntireColumn.Insert
range("M1").Value = "DeptName"


'Dim abbrRange As range              'range to hold the columns with the   dpeartment names
Set abbrRange = range("L:L")

'Writes the department name in the the department name column next to the associated abbr

For Each cell In abbrRange


            If cell.Value = "ACC" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Accounting"
            End If

            If cell.Value = "ACS" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Adolescent, Career and Special Education"
            End If

            If cell.Value = "AES" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Animal and Equine Science"
            End If

            If cell.Value = "AGR" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Agricultural Science"
            End If

            If cell.Value = "AHS" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Applied Health Sciences"
            End If

            If cell.Value = "AHT" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Veterinary Technology and Pre-Veterinary Medicine"
            End If

            If cell.Value = "Art" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Art and Design"
            End If

            If cell.Value = "BIO" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Biology"
            End If

            If cell.Value = "BPA" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Management, Marketing and Business Administration"
            End If

            If cell.Value = "CCD" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Center for Communication Disorders"
            End If

            If cell.Value = "CEAO" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Bachelor of Integrated Studies Program"
            End If

            If cell.Value = "CHE" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Chemistry"
            End If

            If cell.Value = "CLH" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Community Leadership and Human Services"
            End If

            If cell.Value = "COM" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Organizational Communication"
            End If

            If cell.Value = "CSC" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Computer Science and Information Systems"
            End If

            If cell.Value = "ECO" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Economics and Finance"
            End If

            If cell.Value = "ELE" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Early Childhood and Elementary Education"
            End If

            If cell.Value = "ENPH" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of English and Philosophy"
            End If

            If cell.Value = "ELSC" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Educational Studies, Leadership and Counseling"
            End If

            If cell.Value = "GSC" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Geosciences"
            End If

            If cell.Value = "HFA" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Liberal Arts"
            End If

            If cell.Value = "HIS" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of History"
            End If

            If cell.Value = "INDC" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Institute of Engineering"
            End If

            If cell.Value = "IOE" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Institute of Engineering"
            End If

            If cell.Value = "JMC" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Journalism and Mass Communications"
            End If

            If cell.Value = "MAT" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Mathematics and Statistics"
            End If

            If cell.Value = "MLA" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Modern Languages"
            End If

            If cell.Value = "MMB" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Management, Marketing and Business Administration"
            End If

            If cell.Value = "MSP" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Military Science Program"
            End If

            If cell.Value = "MUS" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Music"
            End If

            If cell.Value = "NUR" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Nursing"
            End If

            If cell.Value = "OSH" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Occupational Safety and Health"
            End If

            If cell.Value = "POL" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Political Science and Sociology"
            End If

            If cell.Value = "PSY" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Psychology"
            End If

            If cell.Value = "THR" Then
            cell.Activate
            ActiveCell.Offset(0, 1).Activate
            ActiveCell.Value = "Department of Theatre"
            End If

Next



range("I:I").HorizontalAlignment = xlLeft
range("M:M").HorizontalAlignment = xlLeft

Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True


End Sub

Upvotes: 1

Views: 2070

Answers (3)

Subodh Tiwari sktneer
Subodh Tiwari sktneer

Reputation: 9976

In this scenario, I would prefer arrays, though Dictionary is the good option. An example code would be like this....

Sub Degree_Workbook_Names_major1()
Dim abbrRange As Range
Dim Abbr, Dept()
Dim lr As Long, i As Long

With Application
    .Calculation = xlCalculationManual
    .EnableEvents = False
    .DisplayAlerts = False
    .ScreenUpdating = False
End With

lr = Cells(Rows.Count, "H").End(xlUp).Row
Columns("I").Insert
Range("I1").Value = "DeptName"

Set abbrRange = Range("H2:H" & lr)
Abbr = abbrRange.Value
ReDim Dept(1 To lr)

For i = 1 To UBound(Abbr, 1)
    Select Case UCase(Abbr(i, 1))
        Case "ACC"
            Dept(i) = "Department of Accounting"
        Case "ACS"
            Dept(i) = "Department of Adolescent, Career and Special Education"
        Case "AES"
            Dept(i) = "Department of Animal and Equine Science"
        Case "AGR"
            Dept(i) = "Department of Department of Agricultural Science"
        Case "AHS"
            Dept(i) = "Department of Applied Health Science"
        Case "AHT"
            Dept(i) = "Department of Veterinary Technology and Pre-Veterinary Medicine"
        Case "ART"
            Dept(i) = "Department of Art and Design"
        Case "BIO"
            Dept(i) = "Department of Biology"
        'similarly add rest of the Abbreviations with Case statement and set the array Dept as shown above
    End Select
Next i
Range("I2").Resize(UBound(Dept)).Value = Application.Transpose(Dept)

With Application
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
    .DisplayAlerts = True
    .ScreenUpdating = True
End With

End Sub

Upvotes: 1

Mathieu Guindon
Mathieu Guindon

Reputation: 71167

Every single condition is executing every time, irrespective of Cell.Value.

Working with cells and ranges in a loop is certainly the single slowest thing you can do in Excel VBA, but doing it for a dozen of conditions when you only need to check a single one... is even slower.

Replace it with If...Else If...Else If... ...End If, or use a Select Case block:

Select Case cell.Value
    Case "ABC"
       'handle 'ABC'
    Case "DEF"
       'handle 'DEF'
    '...
    Case "XYZ"
       'handle 'XYZ'
    Case Else
       'handle default
End Select

But that still makes "XYZ" be evaluated only after every single other case has been evaluated.

A better alternative could be to setup a Dictionary. Reference the Microsoft Scripting Runtime library.

Static map As Scripting.Dictionary
If map Is Nothing Then
    Set map = New Scripting.Dictionary
    With map
        .Add "ACC", "Department of Accounting"
        .Add "ACS", "Department of Adolescent, Career and Special Education"
        '...add every possible ABC -> Description map
    End With
End If

cell.Activate
ActiveCell.Offset(0, 1).Activate
If map.Exists(cell.Value) Then ActiveCell.Value = map(cell.Value)

The Static dictionary will only be populated the first time the procedure runs. Then the ActiveCell.Value is simply fetched with a lightning-fast dictionary lookup.

Now, that's likely still going to be very slow. You don't need 2 loops: iterate rows (only the ones you know you need to check), and then do H and L in one single pass. Just that is slicing execution time by half. Avoid .Activate, too; you don't need to work off ActiveCell at all.

Upvotes: 5

Benjamin J.
Benjamin J.

Reputation: 1279

I would recommend to use switch-case statements instead of if statement. See here: https://www.tutorialspoint.com/vba/vba_switch_statement.htm

The problem on your code is, that all if statements are getting checked even if the first one is applicable.

Upvotes: 0

Related Questions