Forum Discussion

Lorenzo Kim's avatar
Lorenzo Kim
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 ...
  • JKPieterse's avatar
    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

Resources