CODEWITHSUNDEEP
excelvbaexcel-2016
Matt Williamson
Matt Williamson

Reputation: 7095

Split words from column and re-join based on criteria from an array

I have a column "D" in my spreadsheet that contains a list of software to install. The list is very long and I only want a few applications to install. Here are a few examples:

Row2: License-E3; Minitab 17; Minitab 18; Proficy Historian 7.0; ;

Row3: License-E3; Attachmate Reflection for UNIX and OpenVMS 14.0; Perceptive Content Desktop Client;

Row4: License-E1; Avaya one-X® Communicator; PipelineBillingInterfaceSystemClient-V2_0; ; SAP-GUI-3Apps; Minitab 18

So, in the first example, I want column D row 2 to just say : License-E3,Minitab 18

Row 3 to say : License-E3,Reflection

And 4 to say : License-E1,Minitab 18

The rows are auto filtered based on the User Id column, which is Column A in this sheet.

The commented section is basically what I want to do.

Here is my code so far:

Sub FilterSoftware()

  Dim cl As Range, rng As Range, Lastrow As Integer, sSoft() As String, i As Long
  Dim vSoft As Variant, sNew As String, j As Long, sNewSoft() As String
    
  vSoft = Array("License-E3", "License-E1", "Reflection", "Minitab 18", "RSIGuard", "Java")
  
      
  Dim Ws As Worksheet: Set Ws = Sheet1
  
  With Ws
    Lastrow = .Range("D" & .Rows.Count).End(xlUp).Row
  End With

  Set rng = Range("D2:D" & Lastrow)

  For Each cl In rng.SpecialCells(xlCellTypeVisible)
      sSoft = Split(cl, ";")
        For i = LBound(sSoft) To UBound(sSoft)
          If Not sSoft(i) = " " Then
            For j = LBound(vSoft) To UBound(vSoft)
              sNewSoft = Split(vSoft(j), " ")
              Debug.Print Trim$(sSoft(i))
              Debug.Print Trim$(vSoft(j))

              'if sSoft(i) contains any words from vSoft(j)
              'Join vSoft(j) with comma delimiter until full
              'and overwrite in column D

            Next j
          End If
        Next i
   Next cl
End Sub

Upvotes: 1

Views: 49

Answers (1)

FaneDuru
FaneDuru

Reputation: 42236

Please, use the next adapted code. It will return in the next column, only for testing reason. If it returns what you need, you can change cl.Offset(0, 1).Value = Join(sNew, ",") with cl.Value = Join(sNew, ","):

Sub FilterSoftware()
  Dim cl As Range, rng As Range, Lastrow As Long, sSoft
  Dim vSoft, sNew, i As Long, j As Long, t As Long
    
  vSoft = Array("License-E3", "License-E1", "Reflection", "Minitab 18", "RSIGuard", "Java")
  
  Dim Ws As Worksheet: Set Ws = ActiveSheet ' Sheet1
  Lastrow = Ws.Range("D" & Ws.rows.count).End(xlUp).row

  Set rng = Range("D2:D" & Lastrow)
  ReDim sNew(UBound(vSoft)) 'redim the array to a dimension to be sure it will include all occurrences
  
  For Each cl In rng.SpecialCells(xlCellTypeVisible)
      sSoft = Split(cl, ";")
        For i = LBound(sSoft) To UBound(sSoft)
          If Not sSoft(i) = "" Then                 'for cases of two consecutive ";"
            For j = LBound(vSoft) To UBound(vSoft)
                If InStr(1, sSoft(i), vSoft(j), vbTextCompare) > 0 Then
                    sNew(t) = vSoft(j): t = t + 1: Exit For
                End If
            Next j
          End If
        Next i
        If t > 0 Then
            ReDim Preserve sNew(t - 1)              'keep only the array filled elements
            cl.Offset(0, 1).Value = Join(sNew, ",") 'put the value in the next column (for testing reason)
            ReDim sNew(UBound(vSoft)): t = 0        'reinitialize the variables
        End If
   Next cl
End Sub

Upvotes: 2

Related Questions