Error Checking Code, Excel 2000 & 2003

J

jfcby

Hello,

My worksheet range B8,D8,E8 through B15,D15,E15 has data like so;

DATE DESCRIPTION TYPE
1/1/2006 Got It! H
1/2/2006 Successful! WH
1/3/2006 Unlimited Possibilities O

I'm need a error checking code if B8,D8,E8 has data then it will check
B9,D9,E9 through B15,D15,E15. But, if B9 does not have data and D9,E9
does have data then it will give MsgBox "ERROR Date is empty". If D9 is
empty but B9,E9 has data then it will give MsgBox "ERROR Description is
empty!". If E9 is empty but B9,D9 has data then it will give MsgBox
"ERROR Type is empty!". Then it highlights the cell color light grey so
the user will know which cell needs data.

Thank you for your help in advance,
jfcby
 
J

jfcby

Hello,

Adding to the previous information I began some code but it does not
check B8,D8,E8 to see if it is blank or has data then move to next row
B9,D9,E9 and if B9,D9 has data and E9 has no data then I need message
box to say "ERROR Type is blank"

Sub ErrorCheckTEST()
Dim Cell As Range
If Range("B8,D8,E8") >= "" Then
If Range("B8") = "" Then
MsgBox "ERROR Date is empty"
If Range("D8") = "" Then
MsgBox "ERROR Description is empty!"
If Range("E8") = "" Then
MsgBox "ERROR Type is empty!"
End If
End If
End If
End If

If Range("B9,D9,E9") >= "" Then
If Range("B9") = "" Then
MsgBox "ERROR Date is empty"
If Range("D9") = "" Then
MsgBox "ERROR Description is empty!"
If Range("E9") = "" Then
MsgBox "ERROR Type is empty!"
End If
End If
End If
End If

If Range("B10,D10,E10") >= "" Then
If Range("B10") = "" Then
MsgBox "ERROR Date is empty"
If Range("D10") = "" Then
MsgBox "ERROR Description is empty!"
If Range("E10") = "" Then
MsgBox "ERROR Type is empty!"
End If
End If
End If
End If

If Range("B11,D11,E11") >= "" Then
If Range("B11") = "" Then
MsgBox "ERROR Date is empty"
If Range("D11") = "" Then
MsgBox "ERROR Description is empty!"
If Range("E11") = "" Then
MsgBox "ERROR Type is empty!"
End If
End If
End If
End If

If Range("B12,D12,E12") >= "" Then
If Range("B12") = "" Then
MsgBox "ERROR Date is empty"
If Range("D12") = "" Then
MsgBox "ERROR Description is empty!"
If Range("E12") = "" Then
MsgBox "ERROR Type is empty!"
End If
End If
End If
End If

If Range("B13,D13,E13") >= "" Then
If Range("B13") = "" Then
MsgBox "ERROR Date is empty"
If Range("D13") = "" Then
MsgBox "ERROR Description is empty!"
If Range("E13") = "" Then
MsgBox "ERROR Type is empty!"
End If
End If
End If
End If

If Range("B14,D14,E14") >= "" Then
If Range("B14") = "" Then
MsgBox "ERROR Date is empty"
If Range("D14") = "" Then
MsgBox "ERROR Description is empty!"
If Range("E14") = "" Then
MsgBox "ERROR Type is empty!"
End If
End If
End If
End If

If Range("B15,D15,E15") >= "" Then
If Range("B15") = "" Then
MsgBox "ERROR Date is empty"
If Range("D15") = "" Then
MsgBox "ERROR Description is empty!"
If Range("E15") = "" Then
MsgBox "ERROR Type is empty!"
End If
End If
End If
End If

End Sub

Thank you for your help,
jfcby
 
T

Tom Ogilvy

Sub ErrorCheckTEST()
Dim i as Long
Dim cell as Range, cell1 as Range
Dim rng as Range
Dim msg(1 to 3) as String
msg(1) = "ERROR Date is empty"
msg(2) = "ERROR Description is empty"
msg(3) = "ERROR Type is empty"

for each cell in Range("B8:B15")
set rng = cell.Range("A1,C1:D1")
i = 1
for each cell1 in rng
if cell1 = "" then
cell1.Interior.ColorIndex = 15
msgbox msg(i) & ": " & cell.Address
end if
i = i + 1
Next cell1
Next cell
End Sub
 
J

jfcby

Hello Tom,

Thank you for the code modification it works great but not exactly the
way I need it to. I wrote a code that works the way I need it but it is
long and was wondering if it could be modified? I tried to change your
code but I could not figure out how.

Sub ErrorCheckData()
'code works

'checks each cell in row have data or no data next row if all blank end
If Range("B8").Value & Range("D8").Value & Range("E8").Value = "" Then
Exit Sub

'checks each cell in row have data next cell or no data message box
If Range("B8").Value > "" Then
ElseIf Range("B8") = "" Then
MsgBox "ERROR Date is empty"
Range("B8").Interior.ColorIndex = 15
End
End If
If Range("D8").Value > "" Then
ElseIf Range("D8") = "" Then
MsgBox "ERROR Description is empty"
Range("D8").Interior.ColorIndex = 15
End
End If
If Range("E8").Value > "" Then
ElseIf Range("E8") = "" Then
MsgBox "ERROR Type is empty"
Range("E8").Interior.ColorIndex = 15
End
End If

'checks each cell in row have data or no data next row if all blank end
If Range("B9").Value & Range("D9").Value & Range("E9").Value = "" Then
Exit Sub

'checks each cell in row have data next cell or no data message box
If Range("B9").Value > "" Then
ElseIf Range("B9") = "" Then
MsgBox "ERROR Date is empty"
Range("B9").Interior.ColorIndex = 15
End
End If
If Range("D9").Value > "" Then
ElseIf Range("D9") = "" Then
MsgBox "ERROR Description is empty"
Range("D9").Interior.ColorIndex = 15
End
End If
If Range("E9").Value > "" Then
ElseIf Range("E9") = "" Then
MsgBox "ERROR Type is empty"
Range("E9").Interior.ColorIndex = 15
End
End If

'checks each cell in row have data or no data next row if all blank end
If Range("B10").Value & Range("D10").Value & Range("E10").Value = ""
Then Exit Sub

'checks each cell in row have data next cell or no data message box
If Range("B10").Value > "" Then
ElseIf Range("B10") = "" Then
MsgBox "ERROR Date is empty"
Range("B10").Interior.ColorIndex = 15
End
End If
If Range("D10").Value > "" Then
ElseIf Range("D10") = "" Then
MsgBox "ERROR Description is empty"
Range("D10").Interior.ColorIndex = 15
End
End If
If Range("E9").Value > "" Then
ElseIf Range("E10") = "" Then
MsgBox "ERROR Type is empty"
Range("E10").Interior.ColorIndex = 15
End
End If

'checks each cell in row have data or no data next row if all blank end
If Range("B11").Value & Range("D11").Value & Range("E11").Value = ""
Then Exit Sub

'checks each cell in row have data next cell or no data message box
If Range("B11").Value > "" Then
ElseIf Range("B11") = "" Then
MsgBox "ERROR Date is empty"
Range("B11").Interior.ColorIndex = 15
End
End If
If Range("D11").Value > "" Then
ElseIf Range("D11") = "" Then
MsgBox "ERROR Description is empty"
Range("D11").Interior.ColorIndex = 15
End
End If
If Range("E11").Value > "" Then
ElseIf Range("E11") = "" Then
MsgBox "ERROR Type is empty"
Range("E11").Interior.ColorIndex = 15
End
End If

'checks each cell in row have data or no data next row if all blank end
If Range("B12").Value & Range("D12").Value & Range("E12").Value = ""
Then Exit Sub

'checks each cell in row have data next cell or no data message box
If Range("B12").Value > "" Then
ElseIf Range("B12") = "" Then
MsgBox "ERROR Date is empty"
Range("B12").Interior.ColorIndex = 15
End
End If
If Range("D12").Value > "" Then
ElseIf Range("D12") = "" Then
MsgBox "ERROR Description is empty"
Range("D12").Interior.ColorIndex = 15
End
End If
If Range("E12").Value > "" Then
ElseIf Range("E12") = "" Then
MsgBox "ERROR Type is empty"
Range("E12").Interior.ColorIndex = 15
End
End If

'checks each cell in row have data or no data next row if all blank end
If Range("B13").Value & Range("D13").Value & Range("E13").Value = ""
Then Exit Sub

'checks each cell in row have data next cell or no data message box
If Range("B13").Value > "" Then
ElseIf Range("B13") = "" Then
MsgBox "ERROR Date is empty"
Range("B13").Interior.ColorIndex = 15
End
End If
If Range("D13").Value > "" Then
ElseIf Range("D13") = "" Then
MsgBox "ERROR Description is empty"
Range("D13").Interior.ColorIndex = 15
End
End If
If Range("E13").Value > "" Then
ElseIf Range("E13") = "" Then
MsgBox "ERROR Type is empty"
Range("E13").Interior.ColorIndex = 15
End
End If

'checks each cell in row have data or no data next row if all blank end
If Range("B14").Value & Range("D14").Value & Range("E14").Value = ""
Then Exit Sub

'checks each cell in row have data next cell or no data message box
If Range("B14").Value > "" Then
ElseIf Range("B14") = "" Then
MsgBox "ERROR Date is empty"
Range("B14").Interior.ColorIndex = 15
End
End If
If Range("D14").Value > "" Then
ElseIf Range("D14") = "" Then
MsgBox "ERROR Description is empty"
Range("D14").Interior.ColorIndex = 15
End
End If
If Range("E14").Value > "" Then
ElseIf Range("E14") = "" Then
MsgBox "ERROR Type is empty"
Range("E14").Interior.ColorIndex = 15
End
End If

'checks each cell in row have data or no data next row if all blank end
If Range("B15").Value & Range("D15").Value & Range("E15").Value = ""
Then Exit Sub

'checks each cell in row have data next cell or no data message box
If Range("B15").Value > "" Then
ElseIf Range("B15") = "" Then
MsgBox "ERROR Date is empty"
Range("B15").Interior.ColorIndex = 15
End
End If
If Range("D15").Value > "" Then
ElseIf Range("D15") = "" Then
MsgBox "ERROR Description is empty"
Range("D15").Interior.ColorIndex = 15
End
End If
If Range("E15").Value > "" Then
ElseIf Range("E15") = "" Then
MsgBox "ERROR Type is empty"
Range("E15").Interior.ColorIndex = 15
End
End If

End Sub


Thank you for your help,
jfcby
 
T

Tom Ogilvy

Sub ErrorCheckTEST()
Dim i as Long
Dim cell as Range, cell1 as Range
Dim rng as Range
Dim msg(1 to 3) as String
msg(1) = "ERROR Date is empty"
msg(2) = "ERROR Description is empty"
msg(3) = "ERROR Type is empty"

for each cell in Range("B8:B15")
set rng = cell.Range("A1,C1:D1")
i = 1
if application.CountBlank(rng) = 3 then exit sub
for each cell1 in rng
if cell1 = "" then
cell1.Interior.ColorIndex = 15
msgbox msg(i) & ": " & cell.Address
exit sub
end if
i = i + 1
Next cell1
Next cell
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Payment calculation 1
Insert Data Last Row Loop through cells Excel 2000 & 2003 5
Loop through Row Range, Excel 2000, 2003 19
VBA-User says active cell jumps to a different sheet upon Save. Please review my code 1
Code does not error but no copy either 4
Advice on multiple macros, same code just a different column 9
Thin Borders 3
application-defined or object defined error 1

Top