VBA, If array has a string or not

Question

I'm trying to parse through a worksheet with raw data. Sometimes the data I have may be of 2 parts (in my case Machines & production, or just Production). Not really competent in VBA, but I split the string into an array using the split key as "&." But when I try to run the comparison using if, it just skips it.

My Code:

Sub sortfill()

' This sub parses through the vendor list and categorizes the vendors according to type

    Dim myarray() As String, mystring As String, arr() As String
    

    Sheet1.Activate
    Cells(2000, 3).Select
    Selection.End(xlUp).Activate
    
    Dim i As Integer
    
    i = Selection.Row
    
    While i > 1
    
    Sheet1.Activate
    Cells(i, 3).Select
    
    mystring = ActiveCell.Value
    
    arr() = Split(mystring, "&")
    
    If UBound(arr) = 0 Then

        If LCase(arr(0)) = "machines" Then
            Selection.CurrentRegion.Copy
            Sheet2.Activate
            Cells(2000, 2).Activate
            Selection.End(xlUp).Activate
            Selection.Offset(2, -1).Activate
            ActiveCell.PasteSpecial
        End If
            
        If LCase(arr(0)) = "factory" Then
            Selection.CurrentRegion.Copy
            Sheet4.Activate
            Cells(2000, 2).Activate
            Selection.End(xlUp).Activate
            Selection.Offset(2, -1).Activate
            ActiveCell.PasteSpecial
        End If
        
        If LCase(arr(0)) = "production" Then
            Selection.CurrentRegion.Copy
            Sheet3.Activate
            Cells(2000, 2).Activate
            Selection.End(xlUp).Activate
            Selection.Offset(2, -1).Activate
            ActiveCell.PasteSpecial
        
        End If
    
    ElseIf UBound(arr) = 1 Then
    
        If LCase(arr(0)) = "machines" Or LCase(arr(1)) = "machines" Then
            Selection.CurrentRegion.Copy
            Sheet2.Activate
            Cells(2000, 2).Activate
            Selection.End(xlUp).Activate
            Selection.Offset(2, -1).Activate
            ActiveCell.PasteSpecial
        End If
            
        If LCase(arr(0)) = "factory" Or LCase(arr(1)) = "factory" Then
            Selection.CurrentRegion.Copy
            Sheet4.Activate
            Cells(2000, 2).Activate
            Selection.End(xlUp).Activate
            Selection.Offset(2, -1).Activate
            ActiveCell.PasteSpecial
        End If
        
        If LCase(arr(0)) = "production" Or LCase(arr(0)) = "production" Then
            Selection.CurrentRegion.Copy
            Sheet3.Activate
            Cells(2000, 2).Activate
            Selection.End(xlUp).Activate
            Selection.Offset(2, -1).Activate
            ActiveCell.PasteSpecial
            
            End If
    End If
    
   i = i - 1
    
    Wend

End Sub

Any help is appreciated :3

Answer 1

• Matching keywords with target cell by InStr
• Assign cells range value instead of pastespecial
• It is good to read: How to avoid using Select in Excel VBA

Option Explicit

Sub sortfill()
    Dim desSht As Worksheet, aKey, aSht, dataRng As Range
    Dim i As Long, c As Range
    aKey = Array("machines", "factory", "production")
    aSht = Array(Sheet2, Sheet3, Sheet4)
    With Sheet1
        Set dataRng = .Range("C2:C" & .Cells(.Rows.Count, 3).End(xlUp).Row)
    End With
    For Each c In dataRng
        If Len(c.Value) > 0 Then
            Set desSht = Nothing
            For i = 0 To UBound(aKey)
                If InStr(1, c.Value, aKey(i), vbTextCompare) > 0 Then
                    Set desSht = aSht(i)
                    Exit For
                End If
            Next
            If Not desSht Is Nothing Then
                With c.CurrentRegion
                    desSht.Cells(desSht.Rows.Count, 2).End(xlUp).Offset(2, -1). _
                        Resize(.Rows.Count, .Columns.Count).Value = .Value
                End With
            End If
        End If
    Next
End Sub

Microsoft documentation:

InStr function