Forum Discussion

cswank's avatar
cswank
Copper Contributor
May 21, 2021
Solved

Working with cells that contain multiple values delimited by commas

I have a column where each cell has up to 5 values (from a multiple choice survey), where possible values are one or more of: A, B, C, D, or E,  and any multiple values in one cell are delimited by c...
excel
  • HansVogelaar's avatar
    HansVogelaar
    May 21, 2021

    cswank 

    1) After turning on Filter, click the filter dropdown arrow in the top cel of the column.

     

     

    Select Text Filters > Contains...

     

     

    Enter A (or B, C, ...) in the box.

    Click OK.

     

    2) Use a formula such as

     

    =COUNTIF($A$2:$A$50, "*A*")

     

    The wildcard characters * tell Excel to count cells that contain A with possibly other text.

Michael_Yeats's avatar
Michael_Yeats
Copper Contributor
Jan 12, 2024
Code is below:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Target.Address = "$I$" & Target.Row Then
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
GoTo Exitsub
Else: If Target.Value = "" Then GoTo Exitsub Else
Application.EnableEvents = False
Newvalue = Target.Value
Application.Undo
Oldvalue = Target.Value
If Oldvalue = "" Then
Target.Value = Newvalue
Else
If InStr(1, Oldvalue, Newvalue) = 0 Then
Target.Value = Oldvalue & vbNewLine & Newvalue
Else:
Target.Value = Oldvalue
End If
End If
End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub

The result populates the cells with multiple selections however, when using filter on the column, it wont pick up cells with more than one selection
  • HansVogelaar's avatar
    HansVogelaar
    MVP
    Jan 12, 2024

    Michael_Yeats 

    As described in an earlier reply, you have to select Text Filters > Contains...

    A range in column I:

    Filter:

    Specify Apple:

    Result:

    • Michael_Yeats's avatar
      Michael_Yeats
      Copper Contributor
      Jan 15, 2024
      Thanks for the help!

      I need Excel to colour code each different value within the multiple values in the same cell. Conditional formatting wont allow this so I'll need to use VB again but don't know where to add the next bit of code.

      Current code:
      Private Sub Worksheet_Change(ByVal Target As Range)
      Dim Oldvalue As String
      Dim Newvalue As String
      Application.EnableEvents = True
      On Error GoTo Exitsub
      If Target.Address = "$I$" & Target.Row Then
      If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
      GoTo Exitsub
      Else: If Target.Value = "" Then GoTo Exitsub Else
      Application.EnableEvents = False
      Newvalue = Target.Value
      Application.Undo
      Oldvalue = Target.Value
      If Oldvalue = "" Then
      Target.Value = Newvalue
      Else
      If InStr(1, Oldvalue, Newvalue) = 0 Then
      Target.Value = Oldvalue & vbNewLine & Newvalue
      Else:
      Target.Value = Oldvalue
      End If
      End If
      End If
      End If
      Application.EnableEvents = True
      Exitsub:
      Application.EnableEvents = True
      End Sub

      The next bit of code I found that may help is:

      Sub ColourPartiaText()
      Dim Row As Integer, Col As Integer
      Dim CurrentCellText As String
      Col = 1
      For Row = 2 To 5
      CurrentCellText = ActiveSheet.Cells(Row, Col).Value
      HotStartPosition = InStr(1, CurrentCellText, "A")
      CoolStartPosition = InStr(1, CurrentCellText, "B")
      CoolStartPosition1 = InStr(1, CurrentCellText, "C")
      CoolStartPosition2 = InStr(1, CurrentCellText, "X")
      CoolStartPosition3 = InStr(1, CurrentCellText, "Y")
      CoolStartPosition4 = InStr(1, CurrentCellText, "Z")
      If HotStartPosition > 0 Then
      ActiveSheet.Cells(Row, Col).Characters(HotStartPosition, 1).Font.Color = RGB(255, 0, 0)
      End If
      If CoolStartPosition > 0 Then
      ActiveSheet.Cells(Row, Col).Characters(CoolStartPosition, 1).Font.Color = RGB(255, 0, 0)
      End If
      If CoolStartPosition1 > 0 Then
      ActiveSheet.Cells(Row, Col).Characters(CoolStartPosition1, 1).Font.Color = RGB(255, 0, 0)
      End If
      If CoolStartPosition2 > 0 Then
      ActiveSheet.Cells(Row, Col).Characters(CoolStartPosition2, 1).Font.Color = RGB(51, 153, 51)
      End If
      If CoolStartPosition3 > 0 Then
      ActiveSheet.Cells(Row, Col).Characters(CoolStartPosition3, 1).Font.Color = RGB(51, 153, 51)
      End If
      If CoolStartPosition4 > 0 Then
      ActiveSheet.Cells(Row, Col).Characters(CoolStartPosition4, 1).Font.Color = RGB(51, 153, 51)
      End If
      Next Row
      End Sub
      • HansVogelaar's avatar
        HansVogelaar
        MVP
        Jan 15, 2024

        Michael_Yeats 

        Replace ColourPartiaText with

        Sub ColourPartialText(rng As Range)
    Dim CurrentCellText As String
    Dim Ltr As Variant
    Dim Pos As Long
    CurrentCellText = rng.Value
    For Each Ltr In Array("A", "B", "C", "X", "Y", "Z")
        Pos = InStr(CurrentCellText, Ltr)
        If Pos > 0 Then
            Select Case Ltr
                Case "A", "B", "C"
                    rng.Characters(Pos, 1).Font.Color = vbRed
                Case Else
                    rng.Characters(Pos, 1).Font.Color = RGB(51, 153, 51)
            End Select
        End If
    Next Ltr
End Sub

        (I corrected Partia to Partial)

        Insert the following line above the last End If in the Worksheet_Change code:

                Call ColourPartialText(Target)

Resources