Forum Discussion

Bronze Contributor

May 16, 2018

Solved

how to make program simpler

I wrote the following program lines (very crude) - but it is working quite well! what it does is checking the cell above - if blank, it will not allow data entry - meaning data should be entered in ...

excel

JKPieterse

May 16, 2018

Hi Lorenzo,

I think this should do it:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    'Only if in right cells:
    Const CSApplicableRows As String = ",4,5,8,11,14,15,16,19,20,21,24,27,30,"    'Please start and end with a comma!!
    Dim oCells2Check As Range
    'Only if one cell was changed
    If Target.Cells.Count > 1 Then Exit Sub
    'Only if cell is in col B or C
    If Intersect(Target, Range("B:C")) Is Nothing Then Exit Sub
    'Only in desginated rows
    If InStr(CSApplicableRows, "," & Target.Row & ",") = 0 Then Exit Sub
    Set oCells2Check = Intersect(Range("B:C"), Target.EntireRow)
    
    If (oCells2Check.Cells(1, 1) > 0 And (oCells2Check.Cells(1, 1).Offset(-1, 0) = 0 Or oCells2Check.Cells(1, 2).Offset(-1, 0) = 0)) _
    Or (oCells2Check.Cells(1, 2) > 0 And (oCells2Check.Cells(1, 1).Offset(-1, 0) = 0 Or oCells2Check.Cells(1, 2).Offset(-1, 0) = 0)) Then

   ' If ([B4] > 0 And ([B3] = 0 Or [C3] = 0)) Or ([C4] > 0 And ([B3] = 0 Or [C3] = 0)) Then
        If oCells2Check.Cells(1, 1) > 0 Then
            oCells2Check.Cells(1, 1).Select
        Else
            oCells2Check.Cells(1, 2).Select
        End If
        MsgBox "ABOVE CELL HAS NO/INCOMPLETE INPUT! Data entry not allowed.."
        Selection.ClearContents
        Exit Sub
    End If
End Sub

JKPieterse

Silver Contributor

May 16, 2018

Hi Lorenzo,

I think this should do it:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    'Only if in right cells:
    Const CSApplicableRows As String = ",4,5,8,11,14,15,16,19,20,21,24,27,30,"    'Please start and end with a comma!!
    Dim oCells2Check As Range
    'Only if one cell was changed
    If Target.Cells.Count > 1 Then Exit Sub
    'Only if cell is in col B or C
    If Intersect(Target, Range("B:C")) Is Nothing Then Exit Sub
    'Only in desginated rows
    If InStr(CSApplicableRows, "," & Target.Row & ",") = 0 Then Exit Sub
    Set oCells2Check = Intersect(Range("B:C"), Target.EntireRow)
    
    If (oCells2Check.Cells(1, 1) > 0 And (oCells2Check.Cells(1, 1).Offset(-1, 0) = 0 Or oCells2Check.Cells(1, 2).Offset(-1, 0) = 0)) _
    Or (oCells2Check.Cells(1, 2) > 0 And (oCells2Check.Cells(1, 1).Offset(-1, 0) = 0 Or oCells2Check.Cells(1, 2).Offset(-1, 0) = 0)) Then

   ' If ([B4] > 0 And ([B3] = 0 Or [C3] = 0)) Or ([C4] > 0 And ([B3] = 0 Or [C3] = 0)) Then
        If oCells2Check.Cells(1, 1) > 0 Then
            oCells2Check.Cells(1, 1).Select
        Else
            oCells2Check.Cells(1, 2).Select
        End If
        MsgBox "ABOVE CELL HAS NO/INCOMPLETE INPUT! Data entry not allowed.."
        Selection.ClearContents
        Exit Sub
    End If
End Sub

Lorenzo Kim

Bronze Contributor

May 16, 2018

Mr Pieterse

Thank you very much for your reply.

it worked almost perfectly except for this scenario:

in the image below - if we delete B3 (600) or C3 (1) [both B3 & C3 should be filled up to constitute a complete data] , B4 & C4 should be deleted- following the rule that no entry can be allowed if above cell is blank or incomplete. in which case B5 & C5 should also be deleted.

same rule would also apply to the other groups (each pink colored boxes forms a group based on components name)

(Should'nt the MsgBox be outside of the loop?)