Skip blank cells or cells with text

[rolly]

I've simplified my requirements (compared to a previous thread) and found some code that partially works. (I found it here on VBAX, but I can't remember who's original work it is, so who ever created it, I appreciate it.) Now I have a start, but need a few changes.

I'd like this to only change the interior color of the cells with a number in them, and to ignore the cells that are blank or have any text in them. Also some cells have a different interior color already, if possible I'd like it to retain it's color. The following code changes the interior color to white for all cells that are not a duplicate.

Here's what I have so far

[VBA]Sub MakeDupsRed()

Dim myRange As Range
Dim strColToSort As String
'Note: first cell in column is considered a heading
'and is not included in the filter.
strColToSort = "D"
Application.ScreenUpdating = False
Set myRange = Columns(strColToSort & ":" & strColToSort)
myRange.Interior.ColorIndex = 3
myRange.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
myRange.Interior.ColorIndex = xlNone
ActiveSheet.ShowAllData
Application.ScreenUpdating = True
End Sub[/VBA]


Thanks
Rolly

[Benzadeus]

Well, it is not very good, but works...
[VBA]Sub MakeDupsRed()

Dim myRange As Range, difRange As Range
Dim strColToSort As String

'Note: first cell in column is considered a heading
'and is not included in the filter.

strColToSort = "D"
Application.ScreenUpdating = False

Set myRange = Columns(strColToSort & ":" & strColToSort)
myRange.Interior.ColorIndex = 3
myRange.AdvancedFilter Action:=xlFilterInPlace, Unique:=True

Set difRange = Range(strColToSort & "1") ' I put that only to avoid an error in the first
' iteration on the loop below.

For Each cell In myRange.Cells
If IsNumeric(cell) Then
Set difRange = Application.Union(difRange, Range(cell.Address))
End If
Next cell

myRange.Interior.ColorIndex = xlNone
ActiveSheet.ShowAllData
difRange.Interior.ColorIndex = xlNone
Application.ScreenUpdating = True
End Sub
[/VBA]

[rolly]

Thanks,

It works better than mine, the blank cells are now no longer red, but now it's not changing red when I intentionally add a duplicate number to test it.

Rolly

[Benzadeus]

Let me see if I got it:

You want only duplicated numbers to be colored on red, am I right?

[rolly]

correct

[Benzadeus]

Would it be this?
[VBA]
Sub MakeDupsRed()

Dim myRange As Range, difRange As Range
Dim strColToSort As String

strColToSort = "D"
Application.ScreenUpdating = False

Set myRange = Columns(strColToSort & ":" & strColToSort)
myRange.Interior.ColorIndex = 3
myRange.SpecialCells(xlBlanks).Interior.ColorIndex = xlNone
myRange.AdvancedFilter Action:=xlFilterInPlace, Unique:=True

For Each cell In myRange.Cells '*
If Not IsNumeric(cell) Then '*
cell.Interior.ColorIndex = xlNone '*
End If '*
Next cell '*

myRange.Interior.ColorIndex = xlNone
ActiveSheet.ShowAllData
Application.ScreenUpdating = True
End Sub
[/VBA]

Comment: I believe it is possible writing commented lines in a better way.

[lucas]

Benzadeus's code works but to get it to work when you input numbers you need to put it in the code for the module as a worksheet Change event.

Benzadeus, I also changed the name of your variable cell to cel to cut down on confusion, not only by users but by the machinary also. cell is an object in excel so we shouldn't use it as a variable......other than that it works great.

[VBA]
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRange As Range, difRange As Range
Dim strColToSort As String
Dim cel As Range

strColToSort = "D"
Application.ScreenUpdating = False

Set myRange = Columns(strColToSort & ":" & strColToSort)
myRange.Interior.ColorIndex = 3
myRange.SpecialCells(xlBlanks).Interior.ColorIndex = xlNone
myRange.AdvancedFilter Action:=xlFilterInPlace, Unique:=True

For Each cel In myRange.Cells '*
If Not IsNumeric(cel) Then '*
cel.Interior.ColorIndex = xlNone '*
End If '*
Next cel '*

myRange.Interior.ColorIndex = xlNone
ActiveSheet.ShowAllData
Application.ScreenUpdating = True
End Sub
[/VBA]

[Benzadeus]

Benzadeus's code works but to get it to work when you input numbers you need to put it in the code for the module as a worksheet Change event.

Hehehe I didn't understand that the code was suppose to do that.


Hey Lucas!

I believe "Cell" isn't an object, "Cells" is it (at least at Excel 2003).


Comment: I believe it is possible writing commented lines in a better way, like selecting all interior.colorindex=xlnone cells at once.

[lucas]

You're right Benzadeus.......cells.......still confusing especially to new people.