preventing entry of data if above cell is empty (adjusted to just columns ABCDGH)

[LFKim2018]

Mr Rothstein had provided me with a nice sub (below) but I need to adjust it to just check columns ABCDGH and not A to J as the original sub. He might be very busy and I would not like to impose too much but I needed the adjusted sub as soon as possible.
so sorry if I've been too pesky..my apologies to the moderator..
many many thanks


Private Sub Worksheet_Change(ByVal Target As Range) Dim Cell As Range On Error GoTo OutOfRange If Target.Row = 2 And Target.Offset(1) = "" Then Exit Sub For Each Cell In Intersect(Target, Columns("A:J")) If Application.CountIf(Range(Cells(2, Cell.Column), Cell.Offset(-1)), "") Or (Cell.Value = "" And Cell.Offset(1).Value <> "") Then MsgBox "You cannot enter a value in a column if one of the cells above it entry cell is blank nor can you delete the contents of a cell if there is a non-blank cell below it!" Application.EnableEvents = False Application.Undo Application.EnableEvents = True Exit For End If NextOutOfRange:End Sub

 

[Logit]

.

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)


Dim Cell As Range
On Error GoTo OutOfRange:
    
    If Target.Row = 2 And Target.Offset(1) = "" Then Exit Sub
        
        For Each Cell In Intersect(Target, Columns("A:H"))
            
            If Application.CountIf(Range(Cells(2, Cell.Column), Cell.Offset(-1)), "") Or (Cell.Value = "" _
                And Cell.Offset(1).Value <> "") Then
                MsgBox "You cannot enter a value in a column if one of the cells above it entry " & _
                "cell is blank nor can you delete the contents of a cell if there is a non-blank cell below it!"
                Application.EnableEvents = False
                Application.Undo
                Application.EnableEvents = True
            End If
            
        Next
        
    
    
OutOfRange:


End Sub

 

[LFKim2018]

.

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)


Dim Cell As Range
On Error GoTo OutOfRange:
    
    If Target.Row = 2 And Target.Offset(1) = "" Then Exit Sub
        
        For Each Cell In Intersect(Target, Columns("A:H"))
            
            If Application.CountIf(Range(Cells(2, Cell.Column), Cell.Offset(-1)), "") Or (Cell.Value = "" _
                And Cell.Offset(1).Value <> "") Then
                MsgBox "You cannot enter a value in a column if one of the cells above it entry " & _
                "cell is blank nor can you delete the contents of a cell if there is a non-blank cell below it!"
                Application.EnableEvents = False
                Application.Undo
                Application.EnableEvents = True
            End If
            
        Next
        
    
    
OutOfRange:


End Sub

Mr Logit
thank you for your reply.
the Intersect(Target, Columns("A:H") is checking columns A to H, the columns EF is included in the checking.
what I need is to check only columns A,B,C,D & G,H
many thanks

 

[LFKim2018]

For a better understanding of my worksheet:
Column A = Date Column B = Return slip no. Column C = Customer name Column D = item description
Column G = Quantity Column H = status
the above columns ABCDGH are all required data entries
Column E = item remarks Column F = item class (automatically filled when (D) item description is entered) this column is 'locked'
Column I = status remarks Column J = resolve
whereas columns EIJ are optional entries (no need to be checked for blanks)
I hope I made myself clear.
many thanks

 

[LFKim2018]

My apologies to Mr. Rothstein, I didn't foresee this scenario when he gave me the code...

 

[Logit]

.

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)


Dim Cell As Range
On Error GoTo OutOfRange:
    
    If Target.Row = 1 And Target.Offset(1) = "" Then Exit Sub
        
        For Each Cell In Intersect(Target, Range("A:D, G:H"))
            
            If Application.CountIf(Range(Cells(2, Cell.Column), Cell.Offset(-1)), "") Or (Cell.Value = "" _
                And Cell.Offset(1).Value <> "") Then
                MsgBox "You cannot enter a value in a column if one of the cells above it entry " & _
                "cell is blank nor can you delete the contents of a cell if there is a non-blank cell below it!"
                Application.EnableEvents = False
                Application.Undo
                Application.EnableEvents = True
            End If
            
        Next
    
OutOfRange:


End Sub

 

[LFKim2018]

Mr Logit,
Thank you for your reply.
I noticed that instead of column you changed it to range("A:D,G:H") - and it worked!
but a small glitch I noticed. When erasing one cell at a time - it checked well.
But when I tried erasing en-masse (meaning erasing simultaneously by hi-lighting several cells) the sub didn't capture the error. I tried to solve it by preventing multiple cell selection but it has side effects.
I hope you get the scenario.
many many thanks

 

[Logit]

.
To prevent selecting more than one cell at a time, use these macros :

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)


Dim Cell As Range
On Error GoTo OutOfRange:
    
    If Target.Row = 2 And Target.Offset(1) = "" Then Exit Sub
        
        For Each Cell In Intersect(Target, Columns("A:H"))
            
            If Application.CountIf(Range(Cells(2, Cell.Column), Cell.Offset(-1)), "") Or (Cell.Value = "" _
                And Cell.Offset(1).Value <> "") Then
                MsgBox "You cannot enter a value in a column if the cell above it is blank " & _
                "nor can you delete the contents of a cell if there is a non-blank cell below it!"
                Application.EnableEvents = False
                Application.Undo
                Application.EnableEvents = True
            End If
            
        Next


OutOfRange:


End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If 2 - Selection.Cells.Count < 1 Then
    MsgBox "You may only select one cell at a time. ", vbCritical, "Selection Error"
End If
End Sub

 

[LFKim2018]

Mr Logit

Thank you for your time.
Your assistance is very much appreciated.
very helpful!

 

[Logit]

.
You are welcome.