PDA

View Full Version : Solved: Special Cells - Count



Philcjr
08-26-2008, 09:31 AM
Can someone take a look at my coding and help me figure out why the Special Cells "Count" is not working... between the commented lines. Oh ya, if there are any other areas in my coding that needs to be tweaked just let me know. Thanks in advance.


Option Explicit
Sub HighlightDups()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets(1)
Dim tmpws As Worksheet: Set tmpws = ThisWorkbook.Sheets.Add
Dim rngFilter As Range, rngUnique As Range, C As Range, rngWhole As Range
Dim lngRows As Long, I As Long, LastRow As Long

With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

If ws.AutoFilterMode Then ws.Cells.AutoFilter 'Check for AutoFilter
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row 'Find last row

Set rngFilter = ws.Range("I1:I" & LastRow) 'Column for unique records
rngFilter.AdvancedFilter xlFilterCopy, , tmpws.Cells(1, 1), True 'Get the unique records
Set rngUnique = tmpws.Range("A2", tmpws.Cells(tmpws.Rows.Count, "A").End(xlUp)) 'Set the range for unique records
Set rngWhole = ws.Range("A1:X" & LastRow) 'Define entire range from sheet1

For Each C In rngUnique
rngWhole.AutoFilter 9, C.Value 'Filter on unique record # from col I
'========================================================================== ==============================
lngRows = Application.WorksheetFunction.Count(ws.Range("I:I").SpecialCells(xlCellTypeVisible))
'========================================================================== ==============================
If lngRows < 2 Then GoTo Skip
With ws.Range("A2:X" & LastRow).SpecialCells(xlCellTypeVisible)
.Interior.ColorIndex = 6 'Yellow
.Font.Bold = True
End With
Skip:
Next C

ws.Cells.AutoFilter 'Turn off AutoFilter
ws.Activate 'Active sheet1
tmpws.Delete 'Delete temp worksheet

Set rngWhole = Nothing: Set rngUnique = Nothing: Set rngFilter = Nothing: Set ws = Nothing

With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Bob Phillips
08-26-2008, 09:40 AM
In what way is it not working, not ignoring the hidden cells? COUNT doesn't ignore hidden cells, you need SUBTOTAL (2 for that.

Philcjr
08-26-2008, 10:45 AM
Bob,

When the AutoFilter does its thing, I want to count the number of rows that are visible. The count is always "0", it is not counting the visible cells, I do not care about hidden cells.

If the count is = to or greater than 2 I want to highlight the rows with yellow

Phil

david000
08-26-2008, 11:55 PM
'========================================================================== ==============================
lngRows = Application.WorksheetFunction.Count(ws.Range("I:I").SpecialCells(xlCellTypeVisible))

MsgBox lngRows
'========================================================================== ==============================


I ran it 50 times and the MsgBox always gave the exact number of visible rows.

Philcjr
08-28-2008, 08:58 AM
Dave,
Thanks for trying

All,
I have attached the file so you can see that the code is not working... any ideas?

david000
08-28-2008, 10:15 PM
Your code will work except the data appears to be text and the count function is failing. I tested it with numbers and it works fine. I tried everthing I know about converting that data to a real number and failed.:dunno
I'm sure someone else can do it.

In the mean time this code will do the job as I understand it.


Sub HiDupz()

Dim x As Long
Dim LastRow As Long

LastRow = Cells(Rows.Count, 1).End(xlUp).Row
For x = LastRow To 1 Step -1
If Application.WorksheetFunction.CountIf(Range("i1:i" & x), Range("i" & x).Text) > 2 Then
Range("A" & x).Resize(, 9).Interior.ColorIndex = 6
End If
Next x

End Sub

Krishna Kumar
08-29-2008, 02:00 AM
Hi,

Try,

lngRows = ws.Range("I2:I" & LastRow).SpecialCells(xlCellTypeVisible).Cells.Count

mikerickson
08-29-2008, 07:09 AM
Try
lngRows = Application.WorksheetFunction.CountA(ws.Range("I:I").SpecialCells(xlCellTypeVisible))

Philcjr
08-29-2008, 05:36 PM
David,
Thanks for all your help.

Krishna,
Thanks, that worked perfectly.

Mikerickson,
That did not work.