VBA code to highlight empty cells that are mandatory

kaz123

New Member
Joined
Oct 8, 2017
Messages
31
Hello


I needed help with identifying all required data that has been left blank. I have multiple workbooks and within each workbook there are multiple worksheets, all have employee related rows of data. I wanted a macro/vba script to be able to automatically go through each worksheets within the workbook and then highlight each required missing cells in yellow. To identify what is mandatory or optional there will be a cell below the column heading that states this.

Please see below example of a spreadsheet of how I want it to look. The cells highlighted in yellow are what is missing required data that have not been populated, this is what I need VBA to do. My workbooks contains many worksheets and each has many columns and rows of data so manually doing this or through conditional formatting is very time consuming.

Screenshot 2021-10-23 at 11.27.29.png


Additionally, if I could run the macro from a separate workbook which allows me to open each workbook to run the code against that would be even better then having to copy and paste the macro in each workbook.

Any assistance will be greatly appreciated.

Thanks
 

Attachments

  • Screenshot 2021-10-23 at 11.05.53.png
    Screenshot 2021-10-23 at 11.05.53.png
    62.8 KB · Views: 11
Last edited:

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney
I assume the header is at row 1.
Try:
VBA Code:
Sub kaz123()

Dim ws As Worksheet
Dim c As Range
Dim sAddress As String, n As Long
Application.ScreenUpdating = False

For Each ws In ActiveWorkbook.Worksheets
n = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
With ws.Rows(2)
    Set c = .Find(What:="Mandatory", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
    SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
    If Not c Is Nothing Then
        sAddress = c.Address
        Do
           On Error Resume Next
           ws.Range(ws.Cells(3, c.Column), ws.Cells(n, c.Column)).SpecialCells(xlCellTypeBlanks).Interior.Color = vbYellow
           On Error GoTo 0
           Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> sAddress
    End If
End With

Next
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Solution
I assume the header is at row 1.
Try:
VBA Code:
Sub kaz123()

Dim ws As Worksheet
Dim c As Range
Dim sAddress As String, n As Long
Application.ScreenUpdating = False

For Each ws In ActiveWorkbook.Worksheets
n = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
With ws.Rows(2)
    Set c = .Find(What:="Mandatory", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
    SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
    If Not c Is Nothing Then
        sAddress = c.Address
        Do
           On Error Resume Next
           ws.Range(ws.Cells(3, c.Column), ws.Cells(n, c.Column)).SpecialCells(xlCellTypeBlanks).Interior.Color = vbYellow
           On Error GoTo 0
           Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> sAddress
    End If
End With

Next
Application.ScreenUpdating = True
End Sub
Thank you very much, I will have a look at this and come back.
 
Upvote 0
Thanks, this works very nicely. One quick question, if the rows with the Mandatory identifier was different for some worksheets I'm guessing I will need to amend below code to search for the first row that has the word "Mandatory"

With ws.Rows(2)
 
Upvote 0
I'm guessing I will need to amend below code to search for the first row that has the word "Mandatory"
Try:
VBA Code:
Sub kaz123_v2()

Dim ws As Worksheet
Dim c As Range, f As Range
Dim sAddress As String, n As Long
Application.ScreenUpdating = False

For Each ws In ActiveWorkbook.Worksheets
n = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Set f = ws.Cells.Find(What:="Mandatory", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
    SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not f Is Nothing Then

    With ws.Rows(f.Row)
        Set c = .Find(What:="Mandatory", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        If Not c Is Nothing Then
            sAddress = c.Address
            Do
               On Error Resume Next
               ws.Range(ws.Cells(3, c.Column), ws.Cells(n, c.Column)).SpecialCells(xlCellTypeBlanks).Interior.Color = vbYellow
               On Error GoTo 0
               Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> sAddress
        End If
    End With
End If

Next
Application.ScreenUpdating = True
End Sub
 
Upvote 0
You're welcome, glad to help & thanks for the feedback.:)
 
Upvote 0

Forum statistics

Threads
1,213,557
Messages
6,114,287
Members
448,562
Latest member
Flashbond

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