Apply Script to More than One Column

tpv0608 · Oct 20th 2017

This is my first post to the forum, but I have been an observer for quite a while. I am fairly new to VBA in excel and have run into a problem I am not sure how to resolve.

Code

Private Sub Worksheet_Change(ByVal Target As Range)


'Color cells based on Selection
If Target.Address = "$C$10" Then
Application.EnableEvents = False
If Range("C10").Value = "COVERAGE" Then
'N/A
    Range("C19:C23").Interior.ColorIndex = xlColorIndexNone 'Highlight Cells
    Range("C19:C23").Interior.ColorIndex = 15 'Highlight cells
    Range("C19:C23").ClearContents  ' Clears Item
    Range("C40:C45").Interior.ColorIndex = xlColorIndexNone 'Highlight Cells
    Range("C40:C45").Interior.ColorIndex = 15 'Highlight cells
    Range("C40:C45").ClearContents  ' Clears Item


ElseIf Range("C10").Value = "CONSUMABLE" Then
'Consumable
    Range("C19:C23").Interior.ColorIndex = xlColorIndexNone 'Highlight Cells
    Range("C40:C45").Interior.ColorIndex = xlColorIndexNone 'Highlight Cells
    Range("C20:C23").Interior.ColorIndex = 15 'Highlight cells
    Range("C20:C23").ClearContents  ' Clears Item
    Range("C40:C45").Interior.ColorIndex = 15 'Highlight cells
    Range("C40:C45").ClearContents  ' Clears Item


End If
Application.EnableEvents = True
End If
End Sub

Display More

I would like this to apply to columns D, E, F, and G (Meaning if Cell D10 = Coverage, cells D19:D23 are cleared and colored, etc). I know I could just repeat the code above, substituting Column D for Column C, but I’m sure there has to be a more efficient way. Any help would be greatly appreciated.

skywriter · Oct 20th 2017

You can try this, it's untested as I don't have a sheet to test it with and I'm too lazy to create one. :cheers:

Code

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)


'Color cells based on Selection
If Target.Address = "$C$10" Then
Application.EnableEvents = False
Dim c As Long
        For c = 3 To 7


            If Cells(10, c).Value = "COVERAGE" Then
            'N/A
                Range(Cells(19, c), Cells(23, c)).Interior.ColorIndex = xlColorIndexNone 'Highlight Cells
                Range(Cells(19, c), Cells(23, c)).Interior.ColorIndex = 15 'Highlight cells
                Range(Cells(19, c), Cells(23, c)).ClearContents  ' Clears Item
                Range(Cells(40, c), Cells(45, c)).Interior.ColorIndex = xlColorIndexNone 'Highlight Cells
                Range(Cells(40, c), Cells(45, c)).Interior.ColorIndex = 15 'Highlight cells
                Range(Cells(40, c), Cells(45, c)).ClearContents  ' Clears Item


            ElseIf Range("C10").Value = "CONSUMABLE" Then
            'Consumable
                Range(Cells(19, c), Cells(23, c)).Interior.ColorIndex = xlColorIndexNone 'Highlight Cells
                Range(Cells(40, c), Cells(45, c)).Interior.ColorIndex = xlColorIndexNone 'Highlight Cells
                Range(Cells(20, c), Cells(23, c)).Interior.ColorIndex = 15 'Highlight cells
                Range(Cells(20, c), Cells(23, c)).ClearContents  ' Clears Item
                Range(Cells(40, c), Cells(45, c)).Interior.ColorIndex = 15 'Highlight cells
                Range(Cells(40, c), Cells(45, c)).ClearContents  ' Clears Item
            End If
        Next c
        Application.EnableEvents = True
    End If
End Sub

Display More

tpv0608 · Oct 20th 2017

Thanks for the reply Bruce. The code works great.

One additional question: As written, the Target Address is fixed in cell C10. Is it possible for a change in cell C10 to clear/highlight only the cells relevant cells in Column C, a change in D10 to clear/highlight only the relevant cells in Column D, etc...?

If that isn't easy to accomplish, a change in either C10, D10, E10 etc to triggering the macro would also work.

Thanks again!!

skywriter · Oct 20th 2017

I think this is what you are asking for. :cheers:

Code

Private Sub Worksheet_Change(ByVal Target As Range)


'Color cells based on Selection
If Target.Count > 1 Then Exit Sub
If Intersect(Range("C10:G10"), Target) Is Nothing Then Exit Sub
Application.EnableEvents = False
Dim c As Long
c = Target.Column
                 If Cells(10, c).Value = "COVERAGE" Then
            'N/A
                Range(Cells(19, c), Cells(23, c)).Interior.ColorIndex = xlColorIndexNone 'Highlight Cells
                Range(Cells(19, c), Cells(23, c)).Interior.ColorIndex = 15 'Highlight cells
                Range(Cells(19, c), Cells(23, c)).ClearContents  ' Clears Item
                Range(Cells(40, c), Cells(45, c)).Interior.ColorIndex = xlColorIndexNone 'Highlight Cells
                Range(Cells(40, c), Cells(45, c)).Interior.ColorIndex = 15 'Highlight cells
                Range(Cells(40, c), Cells(45, c)).ClearContents  ' Clears Item


            ElseIf Range("C10").Value = "CONSUMABLE" Then
            'Consumable
                Range(Cells(19, c), Cells(23, c)).Interior.ColorIndex = xlColorIndexNone 'Highlight Cells
                Range(Cells(40, c), Cells(45, c)).Interior.ColorIndex = xlColorIndexNone 'Highlight Cells
                Range(Cells(20, c), Cells(23, c)).Interior.ColorIndex = 15 'Highlight cells
                Range(Cells(20, c), Cells(23, c)).ClearContents  ' Clears Item
                Range(Cells(40, c), Cells(45, c)).Interior.ColorIndex = 15 'Highlight cells
                Range(Cells(40, c), Cells(45, c)).ClearContents  ' Clears Item
            End If
        Application.EnableEvents = True


End Sub

Display More

tpv0608 · Oct 21st 2017

That is exactly what I was looking for. I can't thank you enough!!!!

skywriter · Oct 21st 2017

My pleasure, thanks for the feedback. :cheers:

I just noticed there's an error in the ElseIf line, if you read this just change it to look like the other line.
In other words change the C10 part to match the other line that looks at what is in C10, D10 etc.

Code

Cells(10, c).Value

Apply Script to More than One Column

Participate now!

Share