Using Data Validation in conjunction with VBA

Felix_Dragonhammer

Board Regular
Joined
Apr 7, 2015
Messages
117
I have a workbook that will be used to help with process of evaluating which products will be carried over into next year.
There is a drop down menu with "Yes" or "No" as answers in B2 that is currently set at "Yes". I also have another series of cells with dropdowns that acts like a checklist. Once one step is completed, you click "Yes". Naturally, if the product is not going to be carried over into the next year, all the steps on the checklist are irrelevant.

What I would like to do is whenever the cell in the "Go Forward?" column is checked to "No" is fill every cell in that row with the color Red: 150, Green; 54 and Blue: 52 and to replace every list in that row marked with an asterisk with the value "No" (i.e. no data validation list).

Any help achieving this would be appreciated.

Here is an example of my current worksheet.

[TABLE="width: 3935"]
<tbody>[TR]
[TD]Full Model Number 2015
[/TD]
[TD]Go Forward?
[/TD]
[TD]Same Model Number?
[/TD]
[TD]Full Model Number 2016
[/TD]
[TD]Retailer
[/TD]
[TD]2015 MAP/MSRP
[/TD]
[TD]MTD Planning Selling Price
[/TD]
[TD]Brand
[/TD]
[TD]Planning ID
[/TD]
[TD]Main Model Name
[/TD]
[TD]Short Description
[/TD]
[TD]Supply drop dead date for prebuild of 9/1?
[/TD]
[TD]Comments
[/TD]
[TD]Okay to release item?
[/TD]
[TD]PMM Sheet Released
[/TD]
[TD]Configuration
[/TD]
[TD]Planning ID created/maintained
[/TD]
[TD]DFUtoSKU created with effectivity updated
[/TD]
[TD]Forecast Updated
[/TD]
[TD]Safety Stock updated
[/TD]
[TD]Last Year Annual
[/TD]
[TD]2016 Planning Volume
[/TD]
[TD]Supply Plan loaded
[/TD]
[TD]Supply Planning Volume
[/TD]
[TD="align: right"]12-Jun
[/TD]
[TD="align: right"]19-Jun
[/TD]
[TD="align: right"]26-Jun
[/TD]
[TD="align: right"]3-Jul
[/TD]
[TD="align: right"]10-Jul
[/TD]
[TD="align: right"]17-Jul
[/TD]
[TD="align: right"]24-Jul
[/TD]
[TD="align: right"]31-Jul
[/TD]
[TD="align: right"]7-Aug
[/TD]
[TD="align: right"]14-Aug
[/TD]
[TD="align: right"]21-Aug
[/TD]
[TD="align: right"]28-Aug
[/TD]
[TD="align: right"]4-Sep
[/TD]
[TD="align: right"]11-Sep
[/TD]
[TD="align: right"]18-Sep
[/TD]
[TD="align: right"]25-Sep
[/TD]
[TD="align: right"]2-Oct
[/TD]
[TD="align: right"]9-Oct
[/TD]
[TD="align: right"]16-Oct
[/TD]
[TD="align: right"]23-Oct
[/TD]
[TD="align: right"]30-Oct
[/TD]
[TD="align: right"]6-Nov
[/TD]
[TD="align: right"]13-Nov
[/TD]
[TD="align: right"]20-Nov
[/TD]
[TD="align: right"]27-Nov
[/TD]
[TD="align: right"]4-Dec
[/TD]
[TD="align: right"]11-Dec
[/TD]
[TD="align: right"]18-Dec
[/TD]
[TD="align: right"]25-Dec
[/TD]
[TD="align: right"]1-Jan
[/TD]
[TD="align: right"]8-Jan
[/TD]
[TD="align: right"]15-Jan
[/TD]
[TD="align: right"]22-Jan
[/TD]
[TD="align: right"]29-Jan
[/TD]
[TD="align: right"]5-Feb
[/TD]
[TD="align: right"]12-Feb
[/TD]
[/TR]
[TR]
[TD]12345
[/TD]
[TD]Yes
[/TD]
[TD]Yes
[/TD]
[TD]12345
[/TD]
[TD]IR
[/TD]
[TD]$399.99
[/TD]
[TD][/TD]
[TD][/TD]
[TD]CC31AS2M5E
[/TD]
[TD]1X 21"
[/TD]
[TD][/TD]
[TD]#REF!
[/TD]
[TD]Same spec as 2015.
[/TD]
[TD]Yes*
[/TD]
[TD]No*
[/TD]
[TD]No*
[/TD]
[TD]No*
[/TD]
[TD]No*
[/TD]
[TD]No*
[/TD]
[TD]No*
[/TD]
[TD]June Forecast
[/TD]
[TD]0
[/TD]
[TD]No*
[/TD]
[TD][/TD]
[TD]x
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
An update: when I try to close the workbook, the following message appears: Compile Error: Expected End of Statement.
Any time an error occurs, make sure to debug and record which line the error was on.

Did you make sure to remove the code from the standard module? Can you take a screen shot of the VBA windows where you pasted the code? I don't think there are any differences between 2010 and 2013 to make it fail.

Jeff
 
Upvote 0
I was able to create a macro that accomplished all the formatting I want to do. However, it is triggered by hitting the keys Ctrl+Shift+N. However, I would prefer so that it is triggered when I change a validation in column B to "No". I'll be looking at your current code and browsing the internet to try and accomplish this while I await your reply, but I wouldn't mind a little help.

Here is my code.

Code:
Sub GoForwardNo()
'
' GoForwardNo Macro
'
' Keyboard Shortcut: Ctrl+Shift+N
'
    ActiveCell.Range("A1:B1,O1:U1,X1").Select
    ActiveCell.Offset(0, 23).Range("A1").Activate
    Selection.Clear
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    ActiveWindow.SmallScroll ToRight:=-4
    ActiveCell.Offset(0, -23).Range("A1").Select
    ActiveCell.FormulaR1C1 = "No "
    ActiveCell.Select
    Selection.Copy
    ActiveCell.Offset(0, 1).Range("A1").Activate
    ActiveSheet.Paste
    ActiveCell.Offset(0, 13).Range("A1").Activate
    ActiveCell.Range("A1,B1,C1,D1,E1,F1,G1").Select
    ActiveCell.Offset(0, 6).Range("A1").Activate
    ActiveCell.Offset(0, -6).Range("A1,B1,C1,D1,E1,F1,G1,J1").Select
    ActiveCell.Offset(0, 3).Range("A1").Activate
    ActiveSheet.Paste
    ActiveCell.Rows("1:1").EntireRow.Select
    Selection.Font.Bold = False
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlGeneral
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveCell.Range("A1:BJ1").Select
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
End Sub
 
Upvote 0
Another point of interest is that when I tried to run the macro, it conflicted with your code and pulled up another error. (With one of the Dim phrases or something).
 
Upvote 0
I found a bit of code similar to what I need.

Code:
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("T:T")) Is Nothing Then 
ActiveSheet.Unprotect 
Dim Cell As Integer 

Range("T2").Select 
Cell = 2 

Do Until Selection = "" 

If Selection = "NO" Then 
Range("A" & Cell & ":T" & Cell).Locked = False 

ElseIf Selection = "YES" Then 
Range("A" & Cell & ":T" & Cell).Locked = True 

End If 

Cell = Cell + 1 

Selection.Offset(1, 0).Select 

Loop 

ActiveSheet.Protect contents:=True, userInterfaceOnly:=True 
ActiveSheet.EnableAutoFilter = True 

End If 

End Sub
Not sure how I would modify this to fit my needs, however.
UPDATE: Found another, more specific code that would help.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1")) Is Nothing Then
Application.EnableEvents = False
Call mymacro
End If
Application.EnableEvents = True
End Sub
 
Last edited:
Upvote 0
I tried to edit my macro slightly, and now it's throwing a an error. (error in bold 9th row from bottom)
Code:
Sub GoForwardNo()
'
' GoForwardNo Macro
'
' Keyboard Shortcut: Ctrl+Shift+N
'
    ActiveCell.Range("A1:B1,O1:U1,X1").Select
    ActiveCell.Offset(0, 23).Range("A1").Activate
    Selection.Clear
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    ActiveCell.Offset(0, -23).Range("A1").Select
    ActiveCell.FormulaR1C1 = "No "
    ActiveCell.Select
    Selection.Copy
    ActiveCell.Offset(0, 1).Range("A1").Activate
    ActiveSheet.Paste
    ActiveCell.Offset(0, 13).Range("A1").Activate
    ActiveCell.Range("A1,B1,C1,D1,E1,F1,G1").Select
    ActiveCell.Offset(0, 6).Range("A1").Activate
    ActiveCell.Offset(0, -6).Range("A1,B1,C1,D1,E1,F1,G1,J1").Select
    ActiveCell.Offset(0, 3).Range("A1").Activate
    ActiveSheet.Paste
    ActiveCell.Rows("1:1").EntireRow.Select
    Selection.Font.Bold = False
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlGeneral
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    [B]ActiveCell.Range("A1:BK").Select
[/B]   With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    ActiveCell.Offset(1, 1).Select
    End With
End Sub
 
Upvote 0
Never mind, I fixed it, it was missing a 1 after the "BK". However, I would still appreciate any help getting it to run after I change a cell value in column B to "No".
 
Upvote 0
Felix, I'm having a hard time helping you. For me to help, I need specific and detailed input because I'm not sitting in front of your computer.
Another point of interest is that when I tried to run the macro, it conflicted with your code and pulled up another error. (With one of the Dim phrases or something).

Just guessing, but I think the code you pasted that I gave you might have the first "Dim" line at the end of the "SUB" line.
Code:
[COLOR=#333333]Private Sub Worksheet_Change(ByVal Target As Range)  Dim i As Range[/COLOR]  Dim Sht As Worksheet [COLOR=#333333]  Dim R As Range
[/COLOR]...
Needs to be
Code:
[COLOR=#333333]Private Sub Worksheet_Change(ByVal Target As Range)  

Dim i As Range[/COLOR]  
Dim Sht As Worksheet [COLOR=#333333] 
Dim R As Range
[/COLOR]
 
Upvote 0
Unfortunately, the change didn't have the desired effect. However, there seems to be some progress. Whenever I type any value in column B, the cell is filled with the desired color. None of the other cells in that row are affected.
 
Upvote 0

Forum statistics

Threads
1,223,911
Messages
6,175,337
Members
452,636
Latest member
laura12345

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top