Problem with vba code to highlight and unhighlight neighbouring cell

[sdennant]

hi there,

i have an issue with the below code. All i want to do is make two columns mandatory "J:J" & "M:M" but the only way i could do this was to create two hidden columns beside them "I" & "L" and base my code on a formula " =IF(J9>"", "", IF(A9>"","Required",""))" if those columns either had the word "required" or nothing to use that as a trigger to highlight the actual columns I wanted to make mandatory and highlight them.

However what i've found is that because the columns i want mandatory have dropdowns in them or the hidden column has a formula in it i cant seem to force a message box to come up and highlight the issued cell red if nothing is selected in the drop down but then if something is selected remove the colour and proceed to save.

the below code is probably drastic but please let me know if you can help simplify this and get it to work?

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  
  Dim ws As Worksheet
  Set ws = ThisWorkbook.Sheets("Deals Agreed 2021")
  Application.ScreenUpdating = False
    Columns("I:I").EntireColumn.Hidden = False
    Columns("L:L").EntireColumn.Hidden = False
    
  Dim r1, r2, MultipleRange As Range
  Set r1 = Range("I:I")
  Set r2 = Range("L:L")
  Set MultipleRange = Union(r1, r2).Find("Required", , xlValues)

If MultipleRange Is Nothing Then
MultipleRange.Offset(, 1).Interior.Color = xlNone
Else
MultipleRange.Offset(, 1).Interior.Color = RGB(255, 0, 0)
MsgBox "Please enter Promotion and Chart Date"
Cancel = True
End If
    Columns("I:I").EntireColumn.Hidden = True
    Columns("L:L").EntireColumn.Hidden = True
Application.ScreenUpdating = True
  End Sub

best,
Steven

 

[sdennant]

and yes you're right. the original designer of the raw data decided to make this sheet in the hundreds of thousands as opposed to setting a number which would have been the better way

 

[Akuini]

to make this sheet in the hundreds of thousands

Hm, that's big, try this one:
The criteria is:
1. The defined range is set to last cell with data in col A.
2. If col J & M is blank (in the defined range) then it will be highlighted. So it doesn't matter if the cells has data validation or not.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim c As Range, n As Long, flag As Boolean

With ThisWorkbook.Sheets("Deals Agreed 2021")
    Application.ScreenUpdating = False
    n = .Range("A" & .Rows.Count).End(xlUp).Row
    
    Set c = Union(.Range("J2:J" & n), .Range("M2:M" & n))
'    Debug.Print c.Address
    
    c.Interior.Color = xlNone
    flag = False
    On Error Resume Next
          c.SpecialCells(xlCellTypeBlanks).Interior.Color = RGB(255, 0, 0)
          If Err.Number > 0 Then flag = True
    On Error GoTo 0
        If flag = False Then
             .Activate
            MsgBox "Please enter Promotion and Chart Date"
            Cancel = True  ' cancelling saving process
        End If
        
    
    Application.ScreenUpdating = True
End With
End Sub

 

[sdennant]

it worked!!! Thank you so much. The only thing is that it no longer shows the location of the cells needing to be filled. Not a big issue but would be cool.

that's three out of the 7 things i wanted the sheet to achieve with VBA rather than formulas and conditional formatting because of the size of this sheet. In my opinion the sheet will probably reach maybe 100k not the amount my boss thinks but cant argue there haha.

the other things she had wanted was these:

• Highlight if the discount/net cost (Col P&Q) does not match the existing deal (Col T)
• If the customer is Tesco (B) they should fill in Mod Break and Store Base (Col N & O)
• A prompt if the customer is a supermarket for them to fill in store base ( I assume this would be just a message box if Column B is either Sainsbury's, Tesco or ASDA etc to fill in Column O)
• A prompt to check for duplicates if a deal for the same ISBN/customer/promotion has already been loaded. (This one is a tough one so it would need to check if there's any row with the same info on them and message box and or flag a message box.)

I am sorry if this is too much to ask. I've figured out locking rows but the above without conditional format is something i'm not sure how to do on such a large sheet.

is it possible? Especially i'm okay with maybe writing one code but when there's multiple changes to be done i'm never sure how to make all the codes work together in the same module.

best,
Steven

and again thanks so much

 

[Akuini]

The only thing is that it no longer shows the location of the cells needing to be filled. Not a big issue but would be cool.

Change this part:
MsgBox "Please enter Promotion and Chart Date"

to:
MsgBox "Please enter Promotion and Chart Date" & vbLf & "You need to fill in cells: " & c.SpecialCells(xlCellTypeBlanks).Address

the other things she had wanted was these:

This is a new problem, so you you need to start a new thread.

You're welcome, glad to help & thanks for the feedback.

 

[sdennant]

Thank you again. Worked a charm