Newbie help needed

[jarzack]

Sorry but this is my first attempt to learning this.

I have an Excel spreadsheet that will be used by one group will fill out a majority of this document and another group will only fill out the cells formatted to RGB (253, 233, 217). I have made this spreadsheet protected and only allows the second group to add data to the colored cells. I need a way to search the selected cells to see if they are empty. If empty then prevent save or close.

What I have so far selects the colored cells but how do I search the ActiveCells to see if they are empty then prevent save/ close?

Sub A_SelectRange()
Range("B2:M276").Select
End Sub

Sub B_SelectOrangeCells()
Dim rCell As Range
Dim lColor As Long
Dim rColored As Range

'Select the orange colored cells
lColor = RGB(253, 233, 217)


Set rColored = Nothing
For Each rCell In Selection
If rCell.Interior.Color = lColor Then
If rColored Is Nothing Then
Set rColored = rCell
Else
Set rColored = Union(rColored, rCell)
End If
End If
Next
If rColored Is Nothing Then
MsgBox "No cells match the color"
Else
rColored.Select

End If
Set rCell = Nothing
Set rColored = Nothing
End Sub

 

[mumps]

Place this macro in the code module for ThisWorkbook. Do the following: Hold down the ALT key and press the F11 key. This will open the Visual Basic Editor. In the left hand pane, double click on "ThisWorkbook". Copy/paste the macros into the empty window that opens up. Close the window to return to your sheet. Try saving or closing the workbook.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.ScreenUpdating = False
    Dim rCell As Range, lColor As Long, rColored As Range
    lColor = RGB(253, 233, 217)
    Set rColored = Nothing
    For Each rCell In Range("B2:M276")
        If rCell.Interior.Color = lColor Then
            If rColored Is Nothing Then
                Set rColored = rCell
            Else
                Set rColored = Union(rColored, rCell)
            End If
        End If
    Next
    If rColored Is Nothing Then
        MsgBox "No cells match the color"
    Else
        rColored.Select
        Application.ScreenUpdating = True
        MsgBox "Some cells in the selected range are empty." & Chr(10) & "Please insert the data into the empty cells before closing the workbook."
    End If
    Cancel = True
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Application.ScreenUpdating = False
    Dim rCell As Range, lColor As Long, rColored As Range
    lColor = RGB(253, 233, 217)
    Set rColored = Nothing
    For Each rCell In Range("B2:M276")
        If rCell.Interior.Color = lColor Then
            If rColored Is Nothing Then
                Set rColored = rCell
            Else
                Set rColored = Union(rColored, rCell)
            End If
        End If
    Next
    If rColored Is Nothing Then
        MsgBox "No cells match the color"
    Else
        rColored.Select
        Application.ScreenUpdating = True
        MsgBox "Some cells in the selected range are empty." & Chr(10) & "Please insert the data into the empty cells before saving the workbook."
    End If
    SaveAUI = False
    Cancel = True
End Sub