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?)
- JKPieterse
  Silver Contributor
  May 16, 2018
  The msgbox is not in any loop as far as I can tell. Note that my sample only checks the entries when a cell in C or D is modified which is on one of the rows as indicated, it does not check all cells.
  - Lorenzo Kim
    Bronze Contributor
    May 16, 2018
    Mr Pieterse
    Thank you very very much