C
Celt
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?
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?