Reputation: 55
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.
@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
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
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
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