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

 

[Akuini]

I don't quite understand the criteria, is it:
If a cell in col A is not blank And col J is blank then highlight col J
If a cell in col D is not blank And col M is blank then highlight col M

If that's the criteria then you don't need the hidden columns & the formula, you can amend your macro to do that.
Let me know if you're interested in this approach.

 

[sdennant]

The hidden columns were only there because I couldn’t figure out how else to do it but basically let’s imagine if they didn’t exist... in columns J and M there are dropdowns in each cell. I wanted the cells to highlight red if nothing has been selected in the dropdown with a message box to pop up notifying the user they had to select from the list and to not leave blank then I wanted it to remove the ref highlight once they selected something then they can proceed to save.

The reason I had a hidden column beside the two columns with a formula that stated if the drop down was blank or filled in and used an offset -1 was because I didn’t know how else to start a code based on what the user selected.

it’s only really J and M I wanted to be looked at. I had a previous chain about this if that helps?

Hi there,

I Wondered if this was even possible and i'm newish to VBA:

Notes: Column J is a data validation list and the below is from A:W

ISBN	Customer	Division	Title	Author	Pub date	RRP	Format	Important Do Not Touch	Promotion	Additional info	Important Do Not Touch	Chart Date	Mod Break	Storebase	Discount	Net Cost	End date	Existing deal in SAP end date	Existing deal in SAP terms	Ratecard		PO
9781408364093	Sainsburys	Hachette Children's Group	Where's the Poo? Sticker Activity Book	Orchard Books	18/03/2021	£4.99	Kids_PB		SS5	SS5 Activity		18/03/2021		138		£ 2.00				£ 350.00		4500125666
9781510202252	Tesco	Hachette Children's Group	The Ickabog	J.K. Rowling	10/11/2020	£20.00	Kids_HB		EPU	EPU		21/01/2021		311		£ 8.40		31/12/9999	8.4	£ 300.00		4500125671
9781408364833	Tesco	Hachette Children's Group	Love from Giraffes Can't Dance	Giles Andreae	07/01/2021	£6.99	Kids_		EPU	EPU		21/01/2021		311		£ 2.80		31/12/9999	2.8	£ 300.00		4500125673
9781510108752	Tesco	Hachette Children's Group	Horrid Henry: Holiday Horrors	Francesca Simon	04/02/2021	£6.99	Kids_PB		AISLE	Power Aisle		08/02/2021		234		£ 2.80		31/12/9999	2.8	£ 390.00		4500125671
9781444956368	Tesco	Hachette Children's Group	Rainy Day Stories	Enid Blyton	18/02/2021	£6.99	Kids_PB		SIDE STACK	Stack		08/02/2021		363		£ 2.80		31/12/9999	2.8	£ 800.00	TRUE	4500125671
9781444954265	Tesco	Hachette Children's Group	Magical Fairy Tales	Enid Blyton	03/09/2020	£6.99	Kids_PB		SIDE STACK	Stack		08/02/2021		363		£ 2.80		01/05/2021	2.8	£ 800.00	TRUE	4500125671
9781444956368		Hachette Children's Group	Rainy Day Stories	Enid Blyton	18/02/2021	£6.99	Kids_PB		AA			20/01/2021
9781444954265		Hachette Children's Group	Magical Fairy Tales	Enid Blyton	03/09/2020	£6.99	Kids_PB	Required			Required

What I'm trying to achieve is:

Essential – need to be included before we circulate

• Make column J “Promotion” mandatory ( In column I I've added this formula to use as the trigger for the msgbox =IF(J9>"", "", IF(A9>"","Required","")) but maybe there's an easier way)
• Make column M “Chart Date” mandatory ( In column L I've added this formula to use as the trigger for the msgbox =IF(M9>0, "", IF(A9>"","Required","")) but maybe there's an easier way )
• When the PO has been filled in the corresponding ratecard cell should be locked ( this i cant figure out because it chucks up all kinds of errors when protecting sheets it will either not run the other macros because some columns are hidden or it will lock the cel but not work all the time.)

These are also the things i want to implement

• Highlight if the discount/net cost does not match the existing deal in SAP
• If the customer is Tesco they should fill in Mod Break and Store Base
• A prompt if the customer is a supermarket for them to fill in store base
• A prompt to check for duplicates if a deal for the same ISBN/customer/promotion has already been loaded.

below are the macros i've tried. maybe i'm close but i have no idea at this point.

This below before save code works but stops working when the locked cell macro is activated. I also wanted it to show the location of the highlighted cel but couldnt figure that out so had to use an offset colour instead. but what i wanted was to essentially if isbn was entered then column J and M to pop up with a message box stating what to do and where to do it and refuse to save otherwise.

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
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

this is the locked row code i used but not sure if this is what i should be doing?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
  Set ws = ThisWorkbook.Sheets("Deals Agreed 2021")
  Dim r1 As Range
  ws.Unprotect
  Set r1 = Range("V:V").Find("TRUE", , xlValues)

If r1 Is Nothing Then
Else
ws.Range("U" & r1.Row).Locked = True
End If
   
    ws.Protect
   
End Sub

i also used this code to change back the red colour to none but doesnt work when the locked cel macro is active

Application.EnableEvents = False

  Dim r1, r2, MultipleRange As Range
  Set r1 = Range("J2:J100000")
  Set r2 = Range("M2:M100000")
  Set MultipleRange = Union(r1, r2)
 
  If Not IsEmpty(Target.Value) Then
  MultipleRange.Interior.Color = xlNone
        End If

basically, i'm lost guys and i have no idea how to get this to seamlessly work where i can fulfil the list of sheet requirements - any help would be amazing.

I hope that makes sense?

 

[Akuini]

in columns J and M there are dropdowns in each cell. I wanted the cells to highlight red if nothing has been selected in the dropdown with a message box to pop up notifying the user they had to select from the list and to not leave blank then I wanted it to remove the ref highlight once they selected something then they can proceed to save.

so the criteria is col J & M must not be blank?
but why your formula includes col A as criteria?
" =IF(J9>"", "", IF(A9>"","Required",""))"

 

[sdennant]

Sorry. Yeah. That formula also checked if something was also in col A. A serial number which was used to identify when a new line was entered. So it would essentially check if that box was entered. Then proceed to tell me if J were required or not. But if you removed it then it wouldn’t action the second IF.

I might not be explaining it as best as I can. But that isn’t what I needed looking at I think. The hidden row J and M and also that formula was only because I couldn’t figure out a way to get my idea to work. So I made it check if A was entered which is the first thing users would enter then they would enter the other columns but i wanted it to flag when they needed to enter col I and L because this is often overlooked when they do.

 

[sdennant]

And one more thing. I did it that way with the formula checking col A to make sure that the word “required” only showed up when needed and not in every cel in that column because that formula is based on the two drop down columns being empty or selected.

 

[Akuini]

Ok, try this:
The criteria is:
All cells with data validation in col J & M must not be blank.
Just make sure there are data validation in col J & M, otherwise it will raise run time error.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim c As Range, z As Range, tx As String

With ThisWorkbook.Sheets("Deals Agreed 2021")
    Set c = .Range("J:J,M:M").SpecialCells(xlCellTypeAllValidation)
    c.Interior.Color = xlNone
    
    If c.Cells.Count <> WorksheetFunction.CountA(c) Then
    
        For Each z In c 'loop through each cell in c
        
            If Len(z) = 0 Then
            tx = tx & "," & z.Address(0, 0)
            z.Interior.Color = RGB(255, 0, 0)
            End If
        Next
        
         .Activate
        MsgBox "Please enter Promotion and Chart Date" & vbLf & "You need to fill in cells: " & Mid(tx, 2)
        Cancel = True  ' cancelling saving process
    
    End If
End With
End Sub

 

[sdennant]

hi there,

thanks for the code. currently all it's done is loop all the way down through column J and freeze excel. I think that's the reason i wanted it to only be on data that's entered in. so that's why i used that formula looking for if column A was filled in so it would not try to look for the rows that are empty.

 

[Akuini]

currently all it's done is loop all the way down through column J and freeze excel.

Ok, try this one:
I'm using last cell with data in col A to defined the range, in this line:
n = .Range("A" & .Rows.Count).End(xlUp).Row

How big is your data? thousands of row?

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim c As Range, z As Range, tx As String, n As Long

With ThisWorkbook.Sheets("Deals Agreed 2021")
    Application.ScreenUpdating = False
    n = .Range("A" & .Rows.Count).End(xlUp).Row
    
    Set c = .Range("J1:J" & n, "M1:M" & n).SpecialCells(xlCellTypeAllValidation)
    c.Interior.Color = xlNone
'    Debug.Print c.Address
    If c.Cells.Count <> WorksheetFunction.CountA(c) Then
    
        For Each z In c 'loop through each cell in c
        
            If Len(z) = 0 Then
            tx = tx & "," & z.Address(0, 0)
            z.Interior.Color = RGB(255, 0, 0)
            End If
        Next
        
         .Activate
        MsgBox "Please enter Promotion and Chart Date" & vbLf & "You need to fill in cells: " & Mid(tx, 2)
        Cancel = True  ' cancelling saving process
    
    End If
    Application.ScreenUpdating = True
End With
End Sub

EDIT: I added Application.ScreenUpdating = False & Application.ScreenUpdating = True

 

[sdennant]

that worked quite well from what i can see and thanks for adding the location of the cel in the code. Smart. It didnt do one thing though, it checked J and marked it red and popped a message up. Upon selecting and resaving it got rid of the red and J worked but it didnt do this for M. it allowed it to be left blank. Oh wait, that's because only J has dropdowns. M is a free text field for the date to be manually entered. Could that somehow be factored in?