Problem with vba code to highlight and unhighlight neighbouring cell

sdennant

New Member
Joined
Mar 17, 2020
Messages
34
Office Version
  1. 365
Platform
  1. Windows
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?

VBA Code:
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
 

Some videos you may like

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,959
Office Version
  1. 365
Platform
  1. Windows
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

New Member
Joined
Mar 17, 2020
Messages
34
Office Version
  1. 365
Platform
  1. Windows
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

ISBNCustomerDivisionTitleAuthorPub dateRRPFormatImportant Do Not TouchPromotionAdditional infoImportant Do Not TouchChart DateMod BreakStorebaseDiscount Net Cost End dateExisting deal in SAP end date Existing deal in SAP terms Ratecard PO
9781408364093SainsburysHachette Children's GroupWhere's the Poo? Sticker Activity BookOrchard Books18/03/2021£4.99Kids_PBSS5SS5 Activity18/03/2021138£ 2.00 £ 350.004500125666
9781510202252TescoHachette Children's GroupThe IckabogJ.K. Rowling10/11/2020£20.00Kids_HBEPUEPU21/01/2021311£ 8.4031/12/99998.4£ 300.004500125671
9781408364833TescoHachette Children's GroupLove from Giraffes Can't DanceGiles Andreae07/01/2021£6.99Kids_EPUEPU21/01/2021311£ 2.8031/12/99992.8£ 300.004500125673
9781510108752TescoHachette Children's GroupHorrid Henry: Holiday HorrorsFrancesca Simon04/02/2021£6.99Kids_PBAISLEPower Aisle08/02/2021234£ 2.8031/12/99992.8£ 390.004500125671
9781444956368TescoHachette Children's GroupRainy Day StoriesEnid Blyton18/02/2021£6.99Kids_PBSIDE STACKStack08/02/2021363£ 2.8031/12/99992.8£ 800.00TRUE4500125671
9781444954265TescoHachette Children's GroupMagical Fairy TalesEnid Blyton03/09/2020£6.99Kids_PBSIDE STACKStack08/02/2021363£ 2.8001/05/20212.8£ 800.00TRUE4500125671
9781444956368Hachette Children's GroupRainy Day StoriesEnid Blyton18/02/2021£6.99Kids_PBAA20/01/2021
9781444954265Hachette Children's GroupMagical Fairy TalesEnid Blyton03/09/2020£6.99Kids_PBRequiredRequired


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.

VBA Code:
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?

VBA Code:
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

VBA Code:
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

Well-known Member
Joined
Feb 1, 2016
Messages
2,959
Office Version
  1. 365
Platform
  1. Windows
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

New Member
Joined
Mar 17, 2020
Messages
34
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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

New Member
Joined
Mar 17, 2020
Messages
34
Office Version
  1. 365
Platform
  1. Windows
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

Well-known Member
Joined
Feb 1, 2016
Messages
2,959
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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.
VBA Code:
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

New Member
Joined
Mar 17, 2020
Messages
34
Office Version
  1. 365
Platform
  1. Windows
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.


1612776136072.png
 

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,959
Office Version
  1. 365
Platform
  1. Windows
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?

VBA Code:
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

New Member
Joined
Mar 17, 2020
Messages
34
Office Version
  1. 365
Platform
  1. Windows
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?
 

Watch MrExcel Video

Forum statistics

Threads
1,127,107
Messages
5,622,780
Members
415,927
Latest member
vedasinternational

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
Top