Forum Discussion
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 sequence - no leaving of blanks on top.
there is a pattern here and I know there is a better way of writing this.
a very much simpler code..
number array in use = 4,5,8,11,14,15,16,19,20,21,24,27,30
the hi-lighted in BOLD is the one that is repetitive with respect to the above array
HELP WILL BE VERY MUCH APPRECIATED
The code inside worksheet_change:
Dim ErrEntry As Boolean
ErrEntry = False
If ([B4] > 0 And ([B3] = 0 Or [C3] = 0)) Or ([C4] > 0 And ([B3] = 0 Or [C3] = 0)) Then
If [B4] > 0 Then
Sheet20.Range("B4").Select
Else
Sheet20.Range("C4").Select
End If
ErrEntry = True
End If
If ([B5] > 0 And ([B4] = 0 Or [C4] = 0)) Or ([C5] > 0 And ([B4] = 0 Or [C4] = 0)) Then
If [B5] > 0 Then
Sheet20.Range("B5").Select
Else
Sheet20.Range("C5").Select
End If
ErrEntry = True
End If
If ([B8] > 0 And ([B7] = 0 Or [C7] = 0)) Or ([C8] > 0 And ([B7] = 0 Or [C7] = 0)) Then
If [B8] > 0 Then
Sheet20.Range("B8").Select
Else
Sheet20.Range("C8").Select
End If
ErrEntry = True
End If
If ([B11] > 0 And ([B10] = 0 Or [C10] = 0)) Or ([C11] > 0 And ([B10] = 0 Or [C10] = 0)) Then
If [B11] > 0 Then
Sheet20.Range("B11").Select
Else
Sheet20.Range("C11").Select
End If
ErrEntry = True
End If
If ([B14] > 0 And ([B13] = 0 Or [C13] = 0)) Or ([C14] > 0 And ([B13] = 0 Or [C13] = 0)) Then
If [B14] > 0 Then
Sheet20.Range("B14").Select
Else
Sheet20.Range("C14").Select
End If
ErrEntry = True
End If
If ([B15] > 0 And ([B14] = 0 Or [C14] = 0)) Or ([C15] > 0 And ([B14] = 0 Or [C14] = 0)) Then
If [B15] > 0 Then
Sheet20.Range("B15").Select
Else
Sheet20.Range("C15").Select
End If
ErrEntry = True
End If
If ([B16] > 0 And ([B15] = 0 Or [C15] = 0)) Or ([C16] > 0 And ([B15] = 0 Or [C15] = 0)) Then
If [B16] > 0 Then
Sheet20.Range("B16").Select
Else
Sheet20.Range("C16").Select
End If
ErrEntry = True
End If
If ([B19] > 0 And ([B18] = 0 Or [C18] = 0)) Or ([C19] > 0 And ([B18] = 0 Or [C18] = 0)) Then
If [B19] > 0 Then
Sheet20.Range("B19").Select
Else
Sheet20.Range("C19").Select
End If
ErrEntry = True
End If
If ([B20] > 0 And ([B19] = 0 Or [C19] = 0)) Or ([C20] > 0 And ([B19] = 0 Or [C19] = 0)) Then
If [B20] > 0 Then
Sheet20.Range("B20").Select
Else
Sheet20.Range("C20").Select
End If
ErrEntry = True
End If
If ([B21] > 0 And ([B20] = 0 Or [C20] = 0)) Or ([C21] > 0 And ([B20] = 0 Or [C20] = 0)) Then
If [B21] > 0 Then
Sheet20.Range("B21").Select
Else
Sheet20.Range("C21").Select
End If
ErrEntry = True
End If
If ([B24] > 0 And ([B23] = 0 Or [C23] = 0)) Or ([C24] > 0 And ([B23] = 0 Or [C23] = 0)) Then
If [B24] > 0 Then
Sheet20.Range("B24").Select
Else
Sheet20.Range("C24").Select
End If
ErrEntry = True
End If
If ([B27] > 0 And ([B26] = 0 Or [C26] = 0)) Or ([C27] > 0 And ([B26] = 0 Or [C26] = 0)) Then
If [B27] > 0 Then
Sheet20.Range("B27").Select
Else
Sheet20.Range("C27").Select
End If
ErrEntry = True
End If
If ([B30] > 0 And ([B29] = 0 Or [C29] = 0)) Or ([C30] > 0 And ([B29] = 0 Or [C29] = 0)) Then
If [B30] > 0 Then
Sheet20.Range("B30").Select
Else
Sheet20.Range("C30").Select
End If
ErrEntry = True
End If
If ErrEntry Then
MsgBox "ABOVE CELL HAS NO/INCOMPLETE INPUT! Data entry not allowed.."
Selection.ClearContents
Exit Sub
End If
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
4 Replies
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 SubMr 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?)
- 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.
