Excel VBA: Highlight values on multiple columns

Luis Diaz
Luis Diaz used Ask the Experts™
on
Hello experts,

The following procedure allows me to add string on multiple columns.


Sub Add_Specific_String_Multiple_Columns()
    
    Dim strSpecificChar As Variant    'New declaration in order to add numeric and non numeric values
    Dim strCol As Variant
    Dim strColList As String
    Dim lngLastRow As Long, lngRow As Long
    Dim intWhich As Integer
    Dim intWhich_temp As String
    Dim strToAdd As String
    
    On Error GoTo Error_Routine

    intWhich = 0
    intWhich_temp = InputBox("Please report value related to the action that you want to perform: 1 for adding string at the beginning 2 at the end")

    If intWhich_temp = vbNullString Then
        MsgBox ("No input!")
        Exit Sub
    End If

    If IsNumeric(intWhich_temp) Then intWhich = intWhich_temp

    Select Case intWhich
        Case 1, 2
        Case Else
            MsgBox "Please enter '1' or '2'"
            Exit Sub
    End Select

    strColList = InputBox("Please report column letter(s) following by ; in which you want to apply procedure," _
        & ": A for single column A;C;D for multiple columns", "Choose Column Letter(s)")
    If strColList = vbNullString Then
        MsgBox ("No input!")
        Exit Sub
    End If
    
    
    strToAdd = InputBox("Input the value that you want to add.", "String To Add!")
    
    If strToAdd = "" Then
        MsgBox "No input!", vbExclamation
        Exit Sub
    End If
    
    For Each strCol In Split(strColList, ";")
        lngLastRow = Range(strCol & Rows.Count).End(xlUp).Row
        strSpecificChar = strToAdd

        For lngRow = 2 To lngLastRow
            Select Case intWhich
                Case 1
                    Cells(lngRow, strCol).Value = strSpecificChar & Cells(lngRow, strCol).Value
                Case 2
                    Cells(lngRow, strCol).Value = Cells(lngRow, strCol).Value & strSpecificChar
            End Select
        Next
    Next
 
    Exit Sub
Error_Routine:
    MsgBox Err.Description, vbExclamation, "Something went wrong!"
    
End Sub

Open in new window


I would like to take it as a reference to cover the following need:
1-Instead of adding specific string I would to highlight values based on specific string.
Inputbox: “Please report the value that you want to highlight”
2-Enter the required filter: 1 for equal, 2 for contains, 3 for not equal, 4 for not contains.
4-Highlight values as following:
1: Green RGB(0,255,0)
2: Green RGB (0,128,0)
3: Red RGB (255,0,0)
4: Marron:RGB (128,0,0)

The rest of the sequence remains the same.


If you have questions, please contact me.

Regards,
Luis.
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Excel & VBA Expert
Most Valuable Expert 2018
Awarded 2015
Commented:
Please give this a try and let me know if this is what you are trying to achieve.


Sub Add_Specific_String_Multiple_Columns()
    
    Dim strCol As Variant
    Dim strColList As String
    Dim lngLastRow As Long, lngRow As Long
    Dim strToHighlight As String
    Dim CompareChoice  As Long
    Dim ColToFilter As Long
    Dim FilterCriteria As String
    Dim clrIndex As Long
    
    On Error GoTo Error_Routine

    strToHighlight = InputBox("Please report the value that you want to highlight.")


    strColList = InputBox("Please report column letter(s) following by ; in which you want to apply procedure," _
        & ": A for single column A;C;D for multiple columns", "Choose Column Letter(s)")
    If strColList = vbNullString Then
        MsgBox ("No input!")
        Exit Sub
    End If
    
    CompareChoice = Application.InputBox("Enter the required filter: 1 for Equal, 2 for Contains, 3 for Not Equal, 4 for Does Not Contain.", "Enter Filter Choice!", Type:=1)
    
    If CompareChoice = 0 Or CompareChoice > 4 Then
        MsgBox "Please enter the filter choice between 1 and 4 only.", vbExclamation, "Invalid Filter Choice!"
        Exit Sub
    End If
    
    Select Case CompareChoice
        Case 1
            FilterCriteria = "=" & strToHighlight
            clrIndex = RGB(0, 255, 0)
        Case 2
            FilterCriteria = "=*" & strToHighlight & "*"
            clrIndex = RGB(0, 128, 0)
        Case 3
            FilterCriteria = "<>" & strToHighlight
            clrIndex = RGB(255, 0, 0)
        Case 4
            FilterCriteria = "<>*" & strToHighlight & "*"
            clrIndex = RGB(128, 0, 0)
    End Select
    
    For Each strCol In Split(strColList, ";")
        lngLastRow = Range(strCol & Rows.Count).End(xlUp).Row
        ColToFilter = Cells(1, strCol).Column
        
        ActiveSheet.FilterMode = False
        
        With Rows(1)
            .AutoFilter field:=ColToFilter, Criteria1:=FilterCriteria
            If Range(Cells(1, strCol), Cells(lngLastRow, strCol)).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
                Range(Cells(2, strCol), Cells(lngLastRow, strCol)).SpecialCells(xlCellTypeVisible).Interior.Color = clrIndex
            End If
            .AutoFilter
        End With
    Next strCol
 
    Exit Sub
Error_Routine:
    MsgBox Err.Description, vbExclamation, "Something went wrong!"
    
End Sub

Open in new window

Luis DiazIT consultant

Author

Commented:
Thank you Subodh, unable to test it right now. I will keep you informed.
Luis DiazIT consultant

Author

Commented:
Subodh,

I tested the proposal for the 4 cases and with multiple columns and the procedure covers the requirement!
Thank you again for your help!
Subodh Tiwari (Neeraj)Excel & VBA Expert
Most Valuable Expert 2018
Awarded 2015

Commented:
You're welcome Luis!
Thanks for the update!

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial