Loop through Row Range, Excel 2000, 2003

  • Thread starter Thread starter jfcby
  • Start date Start date
J

jfcby

Hello,

My BEGIN row range is "B8,D8:E8" END row range is "B15,D15:E15". I need
to check each row value and if the row is all blank I want to exit sub,
if the row range has all data then I want go to continue macro, if a
row has a blank cell I want to continue macro.

This is a example code I've got so far but I do not know how to get it
to loop the the rows:

If Range("B8").Value & Range("D8").Value & Range("E8").Value = "" Then
Exit Sub

Thank you for your help in advance,
jfcby
 
try
for i=8 to 15
if range("B & i &",d"& i & ":e" & i & ")="" then
next i
or
for each c in range("b8:b15")
if c="" and c.offset(,2)="" and c.offset(,3)="" then
next
 
sub demo()
For i = 8 To 15
If Cells(i, "D").Value & Cells(i, "E").Value & Cells(i, "B").Value = ""
Then
Exit Sub
End If
Next
End Sub
 
Fully tested ?

For i = 8 To 15
If Cells(i, "D").Value & Cells(i, "E").Value & Cells(i, "B").Value = ""
If Cells(i, "D").Value AND Cells(i, "E").Value AND & Cells(i,
"B").Value = ""
 
I think Gary's Student was actually concatenating all those cells into a single
string and then comparing that concatenated string to "".

If the OP wanted to use AND, then it would look more like:

if cells(i,"D").value = "" _
and cells(i,"E").value = "" _
and cells(i, "B").value = "" then
.....
 
Hello,

Thanks Don Guillett & Gary's Student with your help I finally got my
code to work!

jfcby
 
Thank you Dave for your help!

jfcby

Dave said:
I think Gary's Student was actually concatenating all those cells into a single
string and then comparing that concatenated string to "".

If the OP wanted to use AND, then it would look more like:

if cells(i,"D").value = "" _
and cells(i,"E").value = "" _
and cells(i, "B").value = "" then
....
 
Hello,

The code provided works great but I'm tring to insert it into this
code2 but it is not working right. It does not go to the next cell it
stays at row 8 and does not go to row 9 and so on. How can this code1
be inserted into code2 to work right?

Dim c As Variant
For c = 8 To 15
If Cells(c, "B").Value & Cells(c, "D").Value & Cells(c,
"E").Value _
= "" Then Exit Sub
Next c

Sub ErrorCheckData()
'Tom Ogilvy
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
End If
i = i + 1
Next cell1
Next Cell
End Sub

Sub ErrorCheckData()
'Tom Ogilvy
Dim i As Long
Dim c As Variant
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 c = 8 To 15
If Cells(c, "B").Value & Cells(c, "D").Value & Cells(c,
"E").Value _
= "" Then Exit Sub
For Each cell1 In Rng
If cell1 = "" Then
cell1.Interior.ColorIndex = 15
MsgBox msg(i) & ": " & Cell.Address
End
End If
i = i + 1
Next cell1
Next c
Next Cell
End Sub

Thank you for your help,
jfcby
 
As previously posted:

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


--
Regards,
Tom Ogilvy

jfcby said:
Hello,

The code provided works great but I'm tring to insert it into this
code2 but it is not working right. It does not go to the next cell it
stays at row 8 and does not go to row 9 and so on. How can this code1
be inserted into code2 to work right?

Dim c As Variant
For c = 8 To 15
If Cells(c, "B").Value & Cells(c, "D").Value & Cells(c,
"E").Value _
= "" Then Exit Sub
Next c

Sub ErrorCheckData()
'Tom Ogilvy
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
End If
i = i + 1
Next cell1
Next Cell
End Sub

Sub ErrorCheckData()
'Tom Ogilvy
Dim i As Long
Dim c As Variant
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 c = 8 To 15
If Cells(c, "B").Value & Cells(c, "D").Value & Cells(c,
"E").Value _
= "" Then Exit Sub
For Each cell1 In Rng
If cell1 = "" Then
cell1.Interior.ColorIndex = 15
MsgBox msg(i) & ": " & Cell.Address
End
End If
i = i + 1
Next cell1
Next c
Next Cell
End Sub

Thank you for your help,
jfcby
 
Hello Tom,

When I tried your code it give me a error message:
Run Time Error '13'
Type Mismatch

and highlights this line of code:
If Application.CountBlank(rng) = 3 Then Exit Sub

Thank you for your help,
jfcby

Tom said:
As previously posted:

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
 
Merry xmas eve
I corrected the 1st one from the original post and either of these will
work.
Your problem is that you want to EXIT the sub if all are blank. Of course,
if the first row is blank then the sub will NOT loop. What do you want?

Sub checkblanksinrow()
For i = 8 To 15
If Range("B" & i & ",d" & i & ":e" & i) = "" Then MsgBox Cells(i, "B").Row
Next i
End Sub
Sub checkblankinrow1()
For Each c In Range("b8:b15")
If c = "" And c.Offset(, 2) = "" And c.Offset(, 3) = "" Then MsgBox c.Row
Next
End Sub
 
My error, here is a correction:

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(cell.Range("A1")) + _
Application.CountBlank(cell.Range("C1:D1")) = 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


--
Regards,
Tom Ogilvy

jfcby said:
Hello Tom,

When I tried your code it give me a error message:
Run Time Error '13'
Type Mismatch

and highlights this line of code:
If Application.CountBlank(rng) = 3 Then Exit Sub

Thank you for your help,
jfcby

Tom said:
As previously posted:

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
 
Just a heads up, but

Sub checkblanksinrow()
For i = 8 To 15
If Range("B" & i & ",d" & i & ":e" & i) = "" Then MsgBox Cells(i, "B").Row
Next i
End Sub


only checks for blanks in column B.
 
Hello Tom,

Thank you for your help! The code works great!

One more questions:

How do you reset the color to No Fill after the blank cells has data in
them?

Thanks for your help,
jfcby



Tom said:
My error, here is a correction:

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(cell.Range("A1")) + _
Application.CountBlank(cell.Range("C1:D1")) = 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


--
Regards,
Tom Ogilvy

jfcby said:
Hello Tom,

When I tried your code it give me a error message:
Run Time Error '13'
Type Mismatch

and highlights this line of code:
If Application.CountBlank(rng) = 3 Then Exit Sub

Thank you for your help,
jfcby
 
Hello Tom,

Thank you for your help once again! My previous question I think the
solution is add Else in the if statement like below is this correct? I
tried it and the colored cells were reset to No Fill.

Sub ErrorCheckData()
'Tom Ogilvy
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(cell.Range("A1")) + _
Application.CountBlank(cell.Range("C1:D1")) = 3 _
Then Exit Sub
For Each cell1 In rng
If cell1 = "" Then
cell1.Interior.ColorIndex = 15
MsgBox msg(i) & ": " & cell.Address
End 'Exit Sub
Else
If cell1 > "" Then
cell1.Interior.ColorIndex = xlNone
End If
End If
i = i + 1
Next cell1
Next cell
End Sub

Merry Christmas!
jfcby
Hello Tom,

Thank you for your help! The code works great!

One more questions:

How do you reset the color to No Fill after the blank cells has data in
them?

Thanks for your help,
jfcby
 
Thank you everyone for your help!

Merry Christmas and Happy New Year!

jfcby
Frankie

Hello Tom,

Thank you for your help! The code works great!

One more questions:

How do you reset the color to No Fill after the blank cells has data in
them?

Thanks for your help,
jfcby
 
I would approach it like this:

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"

Range("B8:B15","D8:E15").Interior.ColorIndex = xlNone
For Each cell In Range("B8:B15")
Set rng = cell.Range("A1,C1:D1")
i = 1
If Application.CountBlank(cell.Range("A1")) + _
Application.CountBlank(cell.Range("C1:D1")) = 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

--
Regards,
Tom Ogilvy


jfcby said:
Hello Tom,

Thank you for your help! The code works great!

One more questions:

How do you reset the color to No Fill after the blank cells has data in
them?

Thanks for your help,
jfcby



Tom said:
My error, here is a correction:

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(cell.Range("A1")) + _
Application.CountBlank(cell.Range("C1:D1")) = 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

Back
Top