How to check cell isnt blank upon saving or closing and color code them to show blanks

[ScottyDo]

Looking forward VBA coding for:
If input is entered into column C (range C2:C100), then row cells for columns D, E ,F, H or I must NOT be blank upon save.
Could be that one or more of these row cells are left blank by mistake.

An error msg pops up upon attempting to save, stops the save and colors each cell yellow that needs info entered into.

Using Excel 2010.

 

[Joe4]

You should be able to do this with a "BeforeSave" event procedure.
Go into the VB editor, and place the following code in the "ThisWorkbook" module.
You may need to change your worksheet name reference to make sure it looks at the correct sheet.

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

    Dim ws As Worksheet
    Dim i As Long
    Dim myCancel As Boolean

'   Set worksheet you want to check
    Set ws = Sheets("Sheet1")

'   Set default value
    myCancel = False

'   Loop through column C
    For i = 2 To 100
        If ws.Cells(i, 3) <> "" Then
'   Loop through columns
            For j = 4 To 9
                If j <> 7 And ws.Cells(i, j) = "" Then
                    ws.Cells(i, j).Interior.Color = 65535
                    myCancel = True
                End If
            Next j
        End If
    Next i
    
'   Check to see if save should be cancelled
    If myCancel Then
        Cancel = True
        ws.Activate
        MsgBox "File cannot be saved, required entries missing and highlighted in yellow"
    End If
    
End Sub

 

[ScottyDo]

Joe4...Works PERFECT! I've thoroughly tested it. Works like a charm and is exactly what I needed. Thank you very much!

 

[ScottyDo]

Hi, because of the file color background, I've changed the color code from yellow to cyan (16776960)
Any chance we can expand a little on this VBA code? Meaning if during a save, column 8 contains either "Printer" or "Thin Client", then column 7 also has to be highlighted to filled in with input.
Column 8 has 5 variables to select from a drop-down list, but only these two need additional input in column 7.

Also after the correct input has been entered into the colored cells lacking input, the cells are re-colored to their default color, which is color code 8576238.

 

[Joe4]

if during a save, column 8 contains either "Printer" or "Thin Client", then column 7 also has to be highlighted to filled in with input.

This code should do that:

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

    Dim ws As Worksheet
    Dim i As Long
    Dim myCancel As Boolean

'   Set worksheet you want to check
    Set ws = Sheets("Sheet1")

'   Set default value
    myCancel = False

'   Loop through column C
    For i = 2 To 100
        If ws.Cells(i, 3) <> "" Then
'   Loop through columns
            For j = 4 To 9
                If j <> 7 And ws.Cells(i, j) = "" Then
                    ws.Cells(i, j).Interior.Color = 16776960
                    myCancel = True
                End If
            Next j
        End If
'   Check columns 8 and 7
        If (Cells(i, 8) = "Printer" Or Cells(i, 8) = "Thin Client") And Cells(i, 7) = "" Then
            ws.Cells(i, 7).Interior.Color = 16776960
            myCancel = True
        End If
    Next i
    
'   Check to see if save should be cancelled
    If myCancel Then
        Cancel = True
        ws.Activate
        MsgBox "File cannot be saved, required entries missing and highlighted in yellow"
    End If
    
End Sub

Also after the correct input has been entered into the colored cells lacking input, the cells are re-colored to their default color, which is color code 8576238.

This will require a Worksheet_Change event procedure module, which is updated upon data entry. So place this code in the Sheet module of the sheet you want to apply it to (i.e. Sheet1 module):

Private Sub Worksheet_Change(ByVal Target As Range)

'   Update cell format color for cells found in range D2:I100 if cell is updated with a value and is not the default color
    If Not (Intersect(Target, Range("D2:I100")) Is Nothing) Then
        If (Target <> "") And (Target.Interior.Color <> 8576238) Then Target.Interior.Color = 8576238
    End If

End Sub

 

[ScottyDo]

Hi Joe4, This POPS! Works great! Thank you so much for your help. Cheers, ScottyDo

 

[Peter_SSs]

I would suggest a change to the Worksheet_Change event code. It will error if more than one cell in D2:I100 is changed at once (eg. Select multiple cells and hit Delete, Copy/Paste multiple cells, Enter multiple cells with Ctrl+Enter)

I've assumed that entries in D2:I100 are not formulas but direct entries (ie constants).
My suggestion:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim FixedCells As Range
    
    On Error Resume Next
        Set FixedCells = Intersect(Target, Intersect(Target, Range("D2:I100")).SpecialCells(xlConstants))
        FixedCells.Interior.Color = 8576238
    On Error GoTo 0
End Sub

 

[ScottyDo]

Hi Petter, actually I've tried deleting multiple cells and coping cells w/o a problem or error popping up. I'm not sure how I would put this into the VBA code I have there already as there is a defined range there.

I am looking to find a way (with present code I have already, see below) how column A input always has to have a "-" (hyphen) after the first three letter characters. i.e (BGA-123) Some people will enter BGA123 which is wrong. The other aspect is that there be "proper case" for columns E and F for the entire string entered there. I.e Dell, Laserjet P2055, Latitude E6250, etc.

The sheet code I'm using thus far is:

#Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("A2:A100, C2:D100, G2:G100")) Is Nothing Then
        With Target
            On Error GoTo ReEnable
            Application.EnableEvents = False
            If Not .HasFormula And Len(.Value) > 0 Then
                .Value = UCase(.Value)
                If .Column > 1 And Application.WorksheetFunction.CountIf(.EntireColumn, .Value) > 1 Then
                    MsgBox "Duplikat input er ikke tillatt!", vbExclamation, "Duplikat input"
                    .ClearContents
                ElseIf .Column = 3 Then
                    If Not .Value Like "PR7#####" And _
                       Not .Value Like "WS8#####" And _
                       Not .Value Like "HW9#####" Then
                       MsgBox "Feil tag input:" & vbCr & vbCr & _
                              "PR700000 til og med PR799999" & vbCr & _
                              "WS800000 til og med WS899999" & vbCr & _
                              "HW900000 til og med HW999999", vbExclamation, _
                              "Feil input"
                        .ClearContents
                    End If
                End If
            End If
        End With
    End If
ReEnable:
    Application.EnableEvents = True
    If Err.Number <> 0 Then MsgBox Err.Description, vbExclamation, "Feil: " & Err.Number
    '   Update cell format color for cells found in range D2:I100 if cell is updated with a value and is not the default color
    If Not (Intersect(Target, Range("A2:I100")) Is Nothing) Then
        If (Target <> "") And (Target.Interior.ColorIndex <> 36) Then Target.Interior.ColorIndex = 36
    End If
End Sub#

For the worksheet I'm using this code:

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

    Dim ws As Worksheet
    Dim i As Long
    Dim myCancel As Boolean

'   Set worksheet you want to check
    Set ws = Sheets("Skjema")

'   Set default value
    myCancel = False

'   Loop through column C
    For i = 2 To 100
        If ws.Cells(i, 3) <> "" Then
'   Loop through columns
            For j = 4 To 9
                If j <> 7 And ws.Cells(i, j) = "" Then
                    ws.Cells(i, j).Interior.Color = 16776960
                    myCancel = True
                End If
            Next j
        End If
'   Check columns 8 and 7
        If (Cells(i, 8) = "Skriver" Or Cells(i, 8) = "Tynnklient") And Cells(i, 7) = "" Then
            ws.Cells(i, 7).Interior.Color = 16776960
            myCancel = True
        End If
    Next i
    
'   Check to see if save should be cancelled
    If myCancel Then
        Cancel = True
        ws.Activate
        MsgBox "Filen lagres ikke. Celler merket blå mangler info og må fylles inn før lagring."
    End If
    
End Sub

If you can help me here, I'd appreciate.

 

[Peter_SSs]

Hi Petter, actually I've tried deleting multiple cells and coping cells w/o a problem or error popping up.

Yes, but that isn't (only) Joe's code.

At the beginning you have

If Target.Count > 1 Then Exit Sub

So if multiple cells change, the rest of the code doesn't execute. Whilst that will stop the error I mentioned, it may stop the following ..

Also after the correct input has been entered into the colored cells lacking input, the cells are re-colored to their default color, which is color code 8576238.

To test, select 2 empty cells that should have entries (blue cells). Type an entry and confirm with Ctrl+Enter, not just Enter. Now the 2 cell should have valid entries, but they will still be blue.

 

[ScottyDo]

A tweak to this growing code.

I've already defined a range for certain columns to be changed to uppercase, but how do I define an additional range of 2 columns (E2:F100) to change input to Proper case?

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("A2:A100, C2:D100, G2:G100")) Is Nothing Then
        With Target
            On Error GoTo ReEnable
            Application.EnableEvents = False
            If Not .HasFormula And Len(.Value) > 0 Then
                .Value = UCase(.Value)
                If .Column > 1 And Application.WorksheetFunction.CountIf(.EntireColumn, .Value) > 1 Then
                    MsgBox "Duplikat input er ikke tillatt!", vbExclamation, "Duplikat input"
                    .ClearContents
                ElseIf .Column = 3 Then
                    If Not .Value Like "PR7#####" And _
                       Not .Value Like "WS8#####" And _
                       Not .Value Like "HW9#####" Then
                       MsgBox "Feil tag input:" & vbCr & vbCr & _
                              "PR700000 til og med PR799999" & vbCr & _
                              "WS800000 til og med WS899999" & vbCr & _
                              "HW900000 til og med HW999999", vbExclamation, _
                              "Feil input"
                        .ClearContents
                    End If
                End If
            End If
        End With
    End If
ReEnable:
    Application.EnableEvents = True
    If Err.Number <> 0 Then MsgBox Err.Description, vbExclamation, "Feil: " & Err.Number
    '   Update cell format color for cells found in range D2:I100 if cell is updated with a value and is not the default color
    If Not (Intersect(Target, Range("A2:I100")) Is Nothing) Then
        If (Target <> "") And (Target.Interior.ColorIndex <> 36) Then Target.Interior.ColorIndex = 36
    End If
End Sub