TIA for any help given!

I have written a macro that searches a range of cells in two separate
columns, looking for empty cells. If it finds an empty cell, the macro
is supposed to look in a horizontal range (on that same row starting one
cell to the right) to see if it contains any data. If it does, then the
macro should color the cell yellow.

My code works up thru the horizontal range part. When I run what I
have now, the macro colors all empty cells (within my set range) yellow
regardless of whether there is data present or not. Here is what I
have:

Option Explicit

Sub BlankNums2()
Dim rng As Range, rng1 As Range
Dim rng2 As Range, rngA As Range
Dim rng3 As Range, rngB As Range
Dim rng4 As Range, rngC As Range, rngD As Range
Dim cell As Range, cellA As Range
Dim icol As Integer, jcol As Integer, krow As Integer

Sheets("Input 502 & 504").Select
With Worksheets("Input 502 & 504")
ActiveSheet.Unprotect Password:="-password-"
ActiveSheet.UsedRange
Set rng = .Range(.Cells(4, 4), _
Cells(4, 256).End(xlToLeft))
Set rngA = rng.Find(What:="Code", After:=rng(1), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=True)
icol = rngA.Column
Set rngB = .Cells(6, 2)
Application.FindFormat.Interior.ColorIndex = 24
With Application.FindFormat.Font
Name = "Arial"
FontStyle = "Bold"
Size = 11
Strikethrough = False
Superscript = False
Subscript = False
Underline = xlUnderlineStyleNone
ColorIndex = xlAutomatic
End With
Set rngC = Cells.Find(What:="", After:=rngB, LookIn:=xlFormulas,
LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=True)
Application.FindFormat.Clear
krow = rngC.Row

Set rng1 = .Range(.Cells(6, 3), _
Cells(krow, 3).Offset(-2, 0))
Set rng2 = .Range(.Cells(6, icol), _
Cells(krow, icol).Offset(-2, 0))
Set rngD = rng.Find(What:="Detailed Description", After:=rng(1), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=True)
jcol = rngD.Column

'-----------------the macro works great up to here. My error has to be
with the "IsEmpty" statements or the way I have defined the horizontals
(rng3 and rng4)

For Each cell In rng1
If IsEmpty(cell) Then
Set rng3 = Range(Cells(cell.Row, 4), .Cells(cell.Row, jcol).Offset(0,
-1))
If Not IsEmpty(rng3) Then
cell.Interior.ColorIndex = 6
End If
End If

For Each cellA In rng2
If IsEmpty(cellA) Then
Set rng4 = .Range(.Cells(cellA.Row, cellA.Column).Offset(0, 1),
Cells(cellA.Row, 256).End(xlToLeft))
If Not IsEmpty(rng4) Then
cellA.Interior.ColorIndex = 6
End If
End If

Next
Next
End With
ActiveSheet.Protect Password:="-password-", DrawingObjects:=True,
Contents:=True, Scenarios:=True _
, AllowInsertingRows:=True, AllowDeletingRows:=True,
AllowSorting:=True
ActiveSheet.EnableSelection = xlUnlockedCells

End Sub

The horizontal ranges (rng3 and rng4) may contain blanks

Any suggestions?


--
Celt
------------------------------------------------------------------------
Celt's Profile: http://www.excelforum.com/member.php...o&userid=19413
View this thread: http://www.excelforum.com/showthread...hreadid=530726

Celt,

Take a look at IsEmpty in help. It is a test of whether a variable has been
initialized or not. You want to use:

If cell.Value = ""

Actually, you should take a look at Conditional Formatting, under the Format
menu in Excel. You could do what you are trying without any VBA.

hth,

Doug


"Celt" wrote in message
...

TIA for any help given!

I have written a macro that searches a range of cells in two separate
columns, looking for empty cells. If it finds an empty cell, the macro
is supposed to look in a horizontal range (on that same row starting one
cell to the right) to see if it contains any data. If it does, then the
macro should color the cell yellow.

My code works up thru the horizontal range part. When I run what I
have now, the macro colors all empty cells (within my set range) yellow
regardless of whether there is data present or not. Here is what I
have:

Option Explicit

Sub BlankNums2()
Dim rng As Range, rng1 As Range
Dim rng2 As Range, rngA As Range
Dim rng3 As Range, rngB As Range
Dim rng4 As Range, rngC As Range, rngD As Range
Dim cell As Range, cellA As Range
Dim icol As Integer, jcol As Integer, krow As Integer

Sheets("Input 502 & 504").Select
With Worksheets("Input 502 & 504")
ActiveSheet.Unprotect Password:="-password-"
ActiveSheet.UsedRange
Set rng = .Range(.Cells(4, 4), _
Cells(4, 256).End(xlToLeft))
Set rngA = rng.Find(What:="Code", After:=rng(1), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=True)
icol = rngA.Column
Set rngB = .Cells(6, 2)
Application.FindFormat.Interior.ColorIndex = 24
With Application.FindFormat.Font
Name = "Arial"
FontStyle = "Bold"
Size = 11
Strikethrough = False
Superscript = False
Subscript = False
Underline = xlUnderlineStyleNone
ColorIndex = xlAutomatic
End With
Set rngC = Cells.Find(What:="", After:=rngB, LookIn:=xlFormulas,
LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=True)
Application.FindFormat.Clear
krow = rngC.Row

Set rng1 = .Range(.Cells(6, 3), _
Cells(krow, 3).Offset(-2, 0))
Set rng2 = .Range(.Cells(6, icol), _
Cells(krow, icol).Offset(-2, 0))
Set rngD = rng.Find(What:="Detailed Description", After:=rng(1), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=True)
jcol = rngD.Column

'-----------------the macro works great up to here. My error has to be
with the "IsEmpty" statements or the way I have defined the horizontals
(rng3 and rng4)

For Each cell In rng1
If IsEmpty(cell) Then
Set rng3 = Range(Cells(cell.Row, 4), .Cells(cell.Row, jcol).Offset(0,
-1))
If Not IsEmpty(rng3) Then
cell.Interior.ColorIndex = 6
End If
End If

For Each cellA In rng2
If IsEmpty(cellA) Then
Set rng4 = .Range(.Cells(cellA.Row, cellA.Column).Offset(0, 1),
Cells(cellA.Row, 256).End(xlToLeft))
If Not IsEmpty(rng4) Then
cellA.Interior.ColorIndex = 6
End If
End If

Next
Next
End With
ActiveSheet.Protect Password:="-password-", DrawingObjects:=True,
Contents:=True, Scenarios:=True _
, AllowInsertingRows:=True, AllowDeletingRows:=True,
AllowSorting:=True
ActiveSheet.EnableSelection = xlUnlockedCells

End Sub

The horizontal ranges (rng3 and rng4) may contain blanks

Any suggestions?


--
Celt
------------------------------------------------------------------------
Celt's Profile:
http://www.excelforum.com/member.php...o&userid=19413
View this thread: http://www.excelforum.com/showthread...hreadid=530726