VBA for Auto Populating with Fixed Values & Shading

[rhmkrmi]

Hello,

Can you help me with a macro please?

I need to auto populate certain cells in different rows with "N/A" and grey shading depending on selections made in column B from a dropdown list.

For example, if we select "School" in cell B19, then E19 to P19 show "N/A" with grey fill colour and if we select "Home" in cell B19, then E19 shows "N/A" with grey fill colour.

Thank you.

 

[Joe4]

You can use a Worksheet_Change event procedure code VBA to do this.
Right-click on the sheet tab name at the bottom of your screen, select "View Code", and paste this code in the resulting window:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range
    Dim cell As Range
    Dim rw As Long
    
'   See if any cells updated in column B
    Set rng = Intersect(Target, Range("B:B"))
    If rng Is Nothing Then Exit Sub
    
'   Loop through updated cells in column B
    For Each cell In rng
        rw = cell.Row
        Select Case cell.Value
            Case "School"
                Range(Cells(rw, "E"), Cells(rw, "P")) = "N/A"
                Range(Cells(rw, "E"), Cells(rw, "P")).Interior.Color = 11711154
            Case "Home"
                Cells(rw, "E") = "N/A"
                Cells(rw, "E").Interior.Color = 11711154
        End Select
    Next cell
    
End Sub

This will automatically do what you want as column B is manually updated (by selecting from drop-down boxes).

 

[rhmkrmi]

Thank you very much, this is great.


Can I ask the following too please:


1. When I first select School and then change back to Home or blank, it does not undo/update. Can this be fixed?


2. How can I find the different codes for colors? I am after fill color combination Red 242, Green 242, and Blue 242 which is slightly lighter than Interior.Color = 11711154


3. When I select School, I want F to R to be affected and not E.


Thanks again!

 

[Joe4]

1. When I first select School and then change back to Home or blank, it does not undo/update. Can this be fixed?

That was not part of the original request, but we can change the code to do that.

2. How can I find the different codes for colors? I am after fill color combination Red 242, Green 242, and Blue 242 which is slightly lighter than Interior.Color = 11711154

Turn on the Macro Recorder, and record yourself shading a cell the color you want. Then stop the Macro Recorder, and take a look at the code. The number it shows is the number for that color.

3. When I select School, I want F to R to be affected and not E.

OK. once again, this can be done, but differs from your original request. It is important to take the time to carefully and completely describe exactly what you want to happen.

For example, if we select "School" in cell B19, then E19 to P19 show "N/A" with grey fill colour

It is easy enough to change the collumns it affects by changing the column letters in the code.
So, if you wanted it to affect F through R, not E through P (like you originally requested), just change references like this:

Range(Cells(rw, "[COLOR=#ff0000][B]E[/B][/COLOR]"), Cells(rw, "[COLOR=#ff0000][B]P[/B][/COLOR]"))

to this:

Range(Cells(rw, "[COLOR=#ff0000][B]F[/B][/COLOR]"), Cells(rw, "[COLOR=#ff0000][B]R[/B][/COLOR]"))

So here are the amendments you requested. Based on the information I provided above, I think you should be able to handle any minor adjustments to colors or ranges to apply it to:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range
    Dim cell As Range
    Dim rw As Long
    
'   See if any cells updated in column B
    Set rng = Intersect(Target, Range("B:B"))
    If rng Is Nothing Then Exit Sub
    
'   Loop through updated cells in column B
    For Each cell In rng
        rw = cell.Row
        Select Case cell.Value
            Case "School"
                Range(Cells(rw, "E"), Cells(rw, "P")) = "N/A"
                Range(Cells(rw, "F"), Cells(rw, "R")).Interior.Color = 11711154
            Case "Home"
                Cells(rw, "E") = "N/A"
                Range(Cells(rw, "F"), Cells(rw, "P")) = "N/A"
                Cells(rw, "E").Interior.Color = 11711154
                Range(Cells(rw, "F"), Cells(rw, "R")).Interior.Pattern = xlNone
            Case Else
                Range(Cells(rw, "E"), Cells(rw, "P")) = ""
                Range(Cells(rw, "F"), Cells(rw, "R")).Interior.Pattern = xlNone
        End Select
    Next cell
    
End Sub

 

[rhmkrmi]

Point taken and thank you very much for updating the code.

This is the final code that I am using:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rng As Range
Dim cell As Range
Dim rw As Long

' See if any cells updated in column B
Set rng = Intersect(Target, Range("B:B"))
If rng Is Nothing Then Exit Sub

' Loop through updated cells in column B
For Each cell In rng
rw = cell.Row
Select Case cell.Value
Case "School"
Range(Cells(rw, "F"), Cells(rw, "R")) = "N/A"
Range(Cells(rw, "F"), Cells(rw, "R")).Interior.Color = 11711154
Case "Home"
Cells(rw, "E") = "N/A"
Cells(rw, "E").Interior.Color = 11711154
Range(Cells(rw, "F"), Cells(rw, "R")).Interior.Pattern = xlNone
Case Else
Range(Cells(rw, "E"), Cells(rw, "R")) = ""
Range(Cells(rw, "E"), Cells(rw, "R")).Interior.Pattern = xlNone
End Select
Next cell

End Sub

I noticed that if the user selects School instead of Home by mistake, then the N/A cells do not update automatically unless the selection from the drop-down list is reset to blank. Is this standard or is there a fix for it? In other words, the only way to reset a wrong selection from the drop-down list is to set it to blank and then re-select the right choice.

My last question, if you could please help, is that how can I have 2 codes in one sheet? Before adding this code, I had the following code existing:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim sUndoList As String
On Error Resume Next
If Not Intersect(Target, Range("A1:ZZ1000")) Is Nothing Then
sUndoList = CommandBars.FindControl(ID:=128).List(1)
If Left(sUndoList, 5) = "Paste" Or sUndoList = "Auto Fill" Or sUndoList = "Drag and Drop" Then
Application.EnableEvents = False
Application.Undo
Application.OnUndo "", ""
Application.EnableEvents = True
End If
End If
End Sub

Thankyou so very much, I do appreciate your help.

 

[Joe4]

You cannot have multiple procedures in the same module with the same name.
You also cannot rename one of them, or else it won't be triggered to run automatically (event procedures have a very strict naming convention that is not flexible).
So what you need to do is include the code for both in one procedure. I usually do two distinct "blocks".
Just note that you might need to make some minor adjustments to make sure that you aren't exiting the sub in the first block so that you never get to the second, or changes from one block invokes the code for the other (handled by disabling events while the updates occur).

So we can structure it like this:

Private Sub Worksheet_Change(ByVal Target As Range)

'   ***BLOCK1***
    Dim sUndoList As String

    On Error Resume Next

    If Not Intersect(Target, Range("A1:ZZ1000")) Is Nothing Then
        sUndoList = CommandBars.FindControl(ID:=128).List(1)
        If Left(sUndoList, 5) = "Paste" Or sUndoList = "Auto Fill" Or sUndoList = "Drag and Drop" Then
            Application.EnableEvents = False
            Application.Undo
            Application.OnUndo "", ""
            Application.EnableEvents = True
        End If
    End If
    

'   ***BLOCK2***
    Dim rng As Range
    Dim cell As Range
    Dim rw As Long

'   See if any cells updated in column B
    Set rng = Intersect(Target, Range("B:B"))
    If rng Is Nothing Then Exit Sub

    Application.EnableEvents = False

'   Loop through updated cells in column B
    For Each cell In rng
        rw = cell.Row
        Select Case cell.Value
            Case "School"
                Range(Cells(rw, "F"), Cells(rw, "R")) = "N/A"
                Range(Cells(rw, "F"), Cells(rw, "R")).Interior.Color = 11711154
            Case "Home"
                Cells(rw, "E") = "N/A"
[COLOR=#ff0000]                Range(Cells(rw, "F"), Cells(rw, "R")) = ""[/COLOR]
                Cells(rw, "E").Interior.Color = 11711154
                Range(Cells(rw, "F"), Cells(rw, "R")).Interior.Pattern = xlNone
            Case Else
                Range(Cells(rw, "E"), Cells(rw, "R")) = ""
                Range(Cells(rw, "E"), Cells(rw, "R")).Interior.Pattern = xlNone
        End Select
    Next cell
    
    Application.EnableEvents = True

End Sub

I noticed that if the user selects School instead of Home by mistake, then the N/A cells do not update automatically unless the selection from the drop-down list is reset to blank. Is this standard or is there a fix for it? In other words, the only way to reset a wrong selection from the drop-down list is to set it to blank and then re-select the right choice.

I think the line I added above in red should handle that. Basically, here is thought process you need to follow:
What is the largest area (range) any option may update?
After determining that, make that range is accounted for EVERY choice.

 

[rhmkrmi]

Thanks again, it is working perfectly fine.

I made some changes and changed the color as well, here is the final code that I am using now:

Private Sub Worksheet_Change(ByVal Target As Range)
' ***BLOCK1***
Dim sUndoList As String
On Error Resume Next
If Not Intersect(Target, Range("A1:ZZ1000")) Is Nothing Then
sUndoList = CommandBars.FindControl(ID:=128).List(1)
If Left(sUndoList, 5) = "Paste" Or sUndoList = "Auto Fill" Or sUndoList = "Drag and Drop" Then
Application.EnableEvents = False
Application.Undo
Application.OnUndo "", ""
Application.EnableEvents = True
End If
End If

' ***BLOCK2***
Dim rng As Range
Dim cell As Range
Dim rw As Long
' See if any cells updated in column B
Set rng = Intersect(Target, Range("B:B"))
If rng Is Nothing Then Exit Sub
Application.EnableEvents = False
' Loop through updated cells in column B
For Each cell In rng
rw = cell.Row
Select Case cell.Value
Case "School"
Range(Cells(rw, "F"), Cells(rw, "S")) = "N/A"
Range(Cells(rw, "F"), Cells(rw, "S")).Interior.Color = 15132390
Case "Home"
Cells(rw, "E") = "N/A"
Range(Cells(rw, "F"), Cells(rw, "S")) = ""
Cells(rw, "E").Interior.Color = 15132390
Range(Cells(rw, "F"), Cells(rw, "S")).Interior.Pattern = xlNone
Case Else
Range(Cells(rw, "E"), Cells(rw, "S")) = ""
Range(Cells(rw, "E"), Cells(rw, "S")).Interior.Pattern = xlNone
End Select
Next cell

Application.EnableEvents = True

End Sub

I am trying to fix something but I can't! When I switch from School to Home it updates correctly but when I switch from Home to School it does not update "E" and "E" keeps showing shaded N/A.

Could you please help me with this bit too?
Thanks for your all your help!

 

[Joe4]

As I mentioned in the previous post, we would need to make sure that every cell in the ranges we are working with are accounted for in each of the three options. Column E is not accounted for under "School". So you would need to add a line like:

[COLOR=#333333]Cells(rw, "E") = ""[/COLOR]

under the "School" option.

 

[rhmkrmi]

Thank you so much, I got it and I fixed it. I am really thankful to you for your help, this is going to make our process very effective.

 

[Joe4]

You are welcome.
Glad I was able to help!