Loop through Row Range, Excel 2000, 2003

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
 
D

Don Guillett

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
 
G

Gary''s Student

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
 
D

Don Guillett

Fully tested ?

For i = 8 To 15
If Cells(i, "D").Value & Cells(i, "E").Value & Cells(i, "B").Value = ""
Click to expand...
If Cells(i, "D").Value AND Cells(i, "E").Value AND & Cells(i,
"B").Value = ""
 
D

Dave Peterson

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
.....
 
J

jfcby

Hello,

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

jfcby
 
J

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
....
Click to expand...
 
J

jfcby

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
 
T

Tom Ogilvy

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
Click to expand...
 
J

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
Click to expand...
 
D

Don Guillett

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
 
T

Tom Ogilvy

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
Click to expand...
Click to expand...
 
T

Tom Ogilvy

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.
 
J

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



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
Click to expand...
Click to expand...
 
J

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
Click to expand...
 
J

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
Click to expand...
 
T

Tom Ogilvy

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
Click to expand...
Click to expand...
 

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

Remove Identical words 0
Insert Data Last Row Loop through cells Excel 2000 & 2003 5
Copy addition formula of non-consecutive horizontal cells 2
Macro Loop 0
Take active cell value in for loop and offset based on another cellvalue for columns to offset 0
MS Project Import Error Row 1 Column 5 2
Range headings 0
Error Checking Code, Excel 2000 & 2003 4

Top