Sam
Sam

Reputation: 55

The way to speed up multiple ElseIf queries in VBA

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.

Option Explicit

Public Sub CL_NC()

Dim lZeile  As Long

With ThisWorkbook.Worksheets("Gesamt")

For lZeile = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
  
If InStr(.Range("D" & lZeile).Value, "Malaysia") > 0 And (InStr(.Range("B" & lZeile).Value, "ISO 9001") > 0 Or InStr(.Range("B" & lZeile).Value, "ISO 14001") > 0 Or InStr(.Range("B" & lZeile).Value, "BS OHSAS 18001") > 0 Or InStr(.Range("B" & lZeile).Value, "ISO 45001") > 0 Or InStr(.Range("B" & lZeile).Value, "ISO 50001") > 0) Then
        .Range("G" & lZeile).Value = "Malaysia IMS CL"
ElseIf InStr(.Range("D" & lZeile).Value, "Malaysia") > 0 And InStr(.Range("C" & lZeile).Value, "IMS") > 0 Then
        .Range("G" & lZeile).Value = "Malaysia IMS NC"
ElseIf InStr(.Range("D" & lZeile).Value, "Malaysia") > 0 Then
        .Range("G" & lZeile).Value = "Malaysia " & .Range("C" & lZeile).Value & " NC"

ElseIf InStr(.Range("D" & lZeile).Value, "Indonesien") > 0 And (InStr(.Range("B" & lZeile).Value, "ISO 9001") > 0 Or InStr(.Range("B" & lZeile).Value, "ISO 14001") > 0 Or InStr(.Range("B" & lZeile).Value, "BS OHSAS 18001") > 0 Or InStr(.Range("B" & lZeile).Value, "ISO 45001") > 0 Or InStr(.Range("B" & lZeile).Value, "ISO 50001") > 0) Then
        .Range("G" & lZeile).Value = "Indonesien IMS CL"
ElseIf InStr(.Range("D" & lZeile).Value, "Indonesien") > 0 And InStr(.Range("C" & lZeile).Value, "IMS") > 0 Then
        .Range("G" & lZeile).Value = "Indonesien IMS NC"
ElseIf InStr(.Range("D" & lZeile).Value, "Indonesien") > 0 Then
        .Range("G" & lZeile).Value = "Indonesien " & .Range("C" & lZeile).Value & " NC"


        
     Else
        .Range("G" & lZeile).Value = ""
     End If
  Next lZeile
End With

End Sub

This is how the table looks right now. Column G should show the VBA result.

enter image description here

@Damian: Dear Damian, your help here was really fantastic. But I am afraid, I need your assistance once again… I have some countries in the table (i.e. Bulgaria“) which obey to the same rules as Malaysia & Indonesia, but additionally they should also be marked as „Bulgaria Food CL“ when the entry in the column B = „ISO 22000“ (in this case the entry in column C is „Food“). Can it also be solved within this code? Thank you so much in advance!

Upvotes: 1

Views: 182

Answers (3)

Damian
Damian

Reputation: 5174

If I got it all right, this should do the trick in seconds:

Option Explicit
Public Sub CL_NC()

    'Looks like your whole range is between A:G columns, so we insert that data
    'inside the array
    
    With ThisWorkbook.Worksheets("Gesamt")
        'Last row
        Dim i  As Long: i = .Cells(.Rows.Count, 1).End(xlUp).Row
        'insert your data into the array
        Dim arr As Variant: arr = .Range("A1:G" & i).Value
        'Declare a Country variable
        Dim Country As String
        'Loop through row 2 to the last (inside the array
        For i = 2 To UBound(arr)
            'Check which country we have
            Select Case GetString(arr(i, 4))
                Case "Malaysia"
                    Country = "Malaysia"
                Case "Indonesien"
                    Country = "Indonesien"
                Case Else
                    arr(i, 7) = vbNullString
                    GoTo NextRow
            End Select
            
            'Check which ISO we have
            Select Case GetString(arr(i, 2))
                Case "ISO 9001", "ISO 14001", "BS OHSAS 18001", "ISO 45001", "ISO 50001"
                    Country = Country & " IMS CL"
                Case Else
                    If arr(i, 3) Like "*IMS*" Then
                        Country = Country & " IMS NC"
                    Else
                        Country = Country & " " & arr(i, 3) & " NC"
                    End If
            End Select
            arr(i, 7) = Country
NextRow:
        Next i
        .AutofilterMode = False
        i = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range("A1:G" & i).Value = arr
    End With

End Sub
Private Function GetString(ByVal KeyValue As String) As String
    'Helper function to extract they key value for the strings
    'You can add as much as you need with Else If
    If KeyValue Like "*Malaysia*" Then
        GetString = "Malaysia"
    ElseIf KeyValue Like "*Indonesien*" Then
        GetString = "Indonesien"
    ElseIf KeyValue Like "*ISO 9001*" Then
        GetString = "ISO 9001"
    ElseIf KeyValue Like "*ISO 14001*" Then
        GetString = "ISO 14001"
    ElseIf KeyValue Like "*ISO 45001*" Then
        GetString = "ISO 45001"
    ElseIf KeyValue Like "*BS OHSAS 18001*" Then
        GetString = "BS OHSAS 18001"
    ElseIf KeyValue Like "*ISO 50001*" Then
        GetString = "ISO 50001"
    End If
End Function

Upvotes: 1

Tomalak
Tomalak

Reputation: 338218

I would start with caching the Range objects you want to work with, the string values you are looking at, and nesting the If between a top-level check for the nation and a nested check for the ISO value:

Option Explicit

Public Sub CL_NC()
  Dim lZeile  As Long
  Dim ws As WorkSheet
  Dim B As Range, Bx As String
  Dim C As Range, Cx As String
  Dim D As Range, Dx As String
  Dim G As Range

  Set ws = ThisWorkbook.Worksheets("Gesamt")      
  Set B = ws.Range("B:B")
  Set C = ws.Range("C:C")
  Set D = ws.Range("D:D")
  Set G = ws.Range("G:G")

  For lZeile = 2 To ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    Bx = B.Cells(lZeile).Value
    Cx = C.Cells(lZeile).Value
    Dx = D.Cells(lZeile).Value
    If InStr(Dx, "Malaysia") > 0 Then
      If InStr(Bx, "ISO 9001") > 0 Or InStr(Bx, "ISO 14001") > 0 Or InStr(Bx, "BS OHSAS 18001") > 0 Or InStr(Bx, "ISO 45001") > 0 Or InStr(Bx, "ISO 50001") > 0 Then
        G.Cells(lZeile).Value = "Malaysia IMS CL"
      ElseIf InStr(Cx, "IMS") > 0 Then
        G.Cells(lZeile).Value = "Malaysia IMS NC"
      Else
        G.Cells(lZeile).Value = "Malaysia " & Cx & " NC"
      End If
    ElseIf InStr(Dx, "Indonesien") > 0 Then
      If InStr(Bx, "ISO 9001") > 0 Or InStr(Bx, "ISO 14001") > 0 Or InStr(Bx, "BS OHSAS 18001") > 0 Or InStr(Bx, "ISO 45001") > 0 Or InStr(Bx, "ISO 50001") > 0 Then
        G.Cells(lZeile).Value = "Indonesien IMS CL"
      ElseIf InStr(Cx, "IMS") > 0 Then
        G.Cells(lZeile).Value = "Indonesien IMS NC"
      Else
        G.Cells(lZeile).Value = "Indonesien " & Cx & " NC"
      End If
    Else
      G.Cells(lZeile).Value = ""
    End If
  Next lZeile
End Sub

This should both be faster and easier to read and understand.

Also check if you really need InStr() or if you could use = directly. The latter will be faster, but it will fail if the data is not clean, e.g. letter case differences, or trailing spaces.

Upvotes: 1

Spencer Barnes
Spencer Barnes

Reputation: 2877

You're checking for "Malaysia" and "Indonesien" each time separately. I don't know how much difference this will make, but I'd have thought the below layout is at least easier to read/edit;

Firstly, Dim strCountry as String near the top. Then inside the For...Next loop put;

'First check the country
If Instr(.Range("D" & LZeile).Value, "Malaysia") Then
    strCountry = "Malaysia "
ElseIf InStr(.Range("D" & lZeile).Value, "Indonesien") > 0 Then
    strCountry = "Indonesien "
Else 'If neither country is found
    strCountry = ""
    .Range("G" & lZeile).Value = ""
End If

If len(strCountry)>0 Then 'if one of the countries was found, then check other elements in column B
   If Instr(.Range("B" & lZeile).Value, "ISO ") > 0 And _
        (InStr(.Range("B" & lZeile).Value, "9001") > 0 Or _
        InStr(.Range("B" & lZeile).Value, "14001") > 0 Or _
        InStr(.Range("B" & lZeile).Value, "45001") > 0 Or _
        InStr(.Range("B" & lZeile).Value, "50001") > 0) Or _
        InStr(.Range("B" & lZeile).Value, "BS OHSAS 18001") > 0  Then
            .Range("G" & lZeile).Value = strCountry & "IMS CL"
    ElseIf InStr(.Range("C" & lZeile).Value, "IMS") > 0 Then
            .Range("G" & lZeile).Value = strCountry & "IMS NC"
    Else
            .Range("G" & lZeile).Value = strCountry & .Range("C" & lZeile).Value & " NC"

    End If
End If

I know that appears more than yours - partly because it's formatted / indented differently - but by putting the 'Malaysia/Indonesia' check separate to the other statements you're lessening how many lines of code actually run. I'd noticed you'd basically copied a lot of those lines with only minor variation - one general goal is to only write any code line once, and make it re-usable for simplicity and speed.

For someone new to vba though, that's an excellent effort! And welcome to Stack Overflow.

Upvotes: 1

Related Questions