I have a spreadsheet that multiple users fill out and turn in daily. In this spreadsheet there are three separate Yes/No questions. If they enter Yes, then in the following column they have to enter data. I want to make a VBA code to check and make sure this data is entered so we don't have to keep sending the spreadsheets back to the users to fill in missing data.
My data is set up like this: K12:K111, N12:N111, and P12:P111 are all the Yes/No columns while L12:L111, O12:O111, and Q12:Q111 are the cells that require text ONLY if a "Yes" was put in the K, N or P columns. Could someone help me with the coding for this?
I would ideally like to put an ActiveX button on the spreadsheet to run the VBA code if possible. I would also like for it to show a dialog box telling which cells need data entered. Any help would be greatly appreciated!
EDIT: I did change the Ranges from M to N as I had misspoken in my original post. I used the code suggested below and am getting a Compile Error: Invalid inside procedure. This is how I pasted it in to correspond to the button:
Private Sub CommandButton2_Click()
Option Explicit
Sub test()
Dim rngK As Range, rngN As Range, rngP As Range, cell As Range
Dim Counter As Long
Counter = 0
With ThisWorkbook.Worksheets("Sheet1")
Set rngK = .Range("K12:K111")
Set rngN = .Range("N12:N111")
Set rngP = .Range("P12:P111")
For Each cell In rngK
If cell.Value = "Yes" And cell.Offset(0, 1).Value = "" Then
cell.Offset(0, 1).Interior.Color = vbRed
Counter = Counter + 1
End If
Next cell
For Each cell In rngN
If cell.Value = "Yes" And cell.Offset(0, 1).Value = "" Then
cell.Offset(0, 1).Interior.Color = vbRed
Counter = Counter + 1
End If
Next cell
For Each cell In rngP
If cell.Value = "Yes" And cell.Offset(0, 1).Value = "" Then
cell.Offset(0, 1).Interior.Color = vbRed
Counter = Counter + 1
End If
Next cell
If Counter > 0 Then
MsgBox "Please fill red highlighted fields!"
End If
End With
End Sub
End Sub
You could try the below:
Option Explicit
Sub test()
Dim rngK As Range, rngM As Range, rngP As Range, cell As Range
Dim Counter As Long
Counter = 0
With ThisWorkbook.Worksheets("Sheet1")
Set rngK = .Range("K12:K111")
Set rngM = .Range("M12:M111")
Set rngP = .Range("P12:P111")
For Each cell In rngK
If cell.Value = "Yes" And cell.Offset(0, 1).Value = "" Then
cell.Offset(0, 1).Interior.Color = vbRed
Counter = Counter + 1
End If
Next cell
For Each cell In rngM
If cell.Value = "Yes" And cell.Offset(0, 2).Value = "" Then
cell.Offset(0, 2).Interior.Color = vbRed
Counter = Counter + 1
End If
Next cell
For Each cell In rngP
If cell.Value = "Yes" And cell.Offset(0, 1).Value = "" Then
cell.Offset(0, 1).Interior.Color = vbRed
Counter = Counter + 1
End If
Next cell
If Counter > 0 Then
MsgBox "Please fill red highlighted fields!"
End If
End With
End Sub
As per OP request:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("K12:K111, M12:M111,P12:P111")) Is Nothing Then
With Target
If UCase(.Value) = "YES" Then
.Offset(0, 1).Interior.Color = vbRed
Else
.Offset(0, 1).Interior.Pattern = xlNone
End If
End With
End If
If Not Intersect(Target, Me.Range("L12:L111, O12:O111,Q12:Q111")) Is Nothing Then
With Target
If .Value = "" And UCase(.Offset(0, -1).Value) = "YES" Then
.Offset(0, 1).Interior.Color = vbRed
Else
.Interior.Pattern = xlNone
End If
End With
End If
End Sub