J
John
Hi All,
First, thanks for your time:
I wrote a UDF function that counts background colors. It takes a cell
argument with the background color that I want to count. I work out the
range in the function because the top of the sheet is like a report
(headings, legend, and color count that kind of stuff); the data is
pasted below the top part. I know the first row and find the last row.
Here is the issue. There are 2 sheets in the work book that use this
function. When I hit Atl -> Ctrl -> Shift -> F9 it counts the colors
but puts the count the in both sheets instead of each sheet having
it's own count of the colors that are on it. I pasted the code below.
Please help I'm about to start pulling my hair out.
'counts colored cells in given range by color
Function CountProjects(RngColor As Range) As Integer
Dim Srow As Long 'Start Row
Dim Erow As Long 'End Row
Dim Crow As Long 'Current Row
Dim Cll As Range 'range of cells
Dim Clr As Long 'color
Dim Rng As Range 'range of cells to look at for
color
Dim xlCalc As XlCalculation
''''''''''''''''''''''''''''''''''
Dim savScrnUD As Boolean 'for speeding
up calculations '
savScrnUD = Application.ScreenUpdating 'only
'
Application.ScreenUpdating = False '
'
xlCalc = Application.Calculation '
'
Application.Calculation = xlCalculationManual
''''''''''''''''''''''''''''''''''
On Error GoTo CalcBack 'Error
Handler
With ActiveSheet
.DisplayPageBreaks = False
Erow = .Cells(.Rows.Count, "A").End(xlUp).Row 'Find last
record of data
End With
Clr = RngColor.Range("A1").Interior.Color 'color =
selected cell color
If ActiveSheet.Name = "AFESummaryRpt" Then
Srow = 13 'set start
row for AFESummaryRpt
' Sheets("AFESummaryRpt").Select
ElseIf ActiveSheet.Name = "AlignBudgetReport" Then
Srow = 9 ' set
start row for AlignBudgetReport
' Sheets("AlignBudgetReport").Select
End If
Set Rng = Range("A" & Srow & ":" & "O" & Erow) 'set cell
range for whichever sheet is active
For Each Cll In Rng 'loop thru
cells in range
If Cll.Interior.Color = Clr Then 'if cell
color matchs cell in range
CountProjects = CountProjects + 1 'add one
to count of colors
End If
Next Cll
CalcBack:
If Err Then MsgBox Err.Description 'If error messagebox error
description
Application.Calculation = xlCalc 'Set speed up options back
to normal
Application.ScreenUpdating = savScrnUD 'Set speed up options back
to normal
End Function
First, thanks for your time:
I wrote a UDF function that counts background colors. It takes a cell
argument with the background color that I want to count. I work out the
range in the function because the top of the sheet is like a report
(headings, legend, and color count that kind of stuff); the data is
pasted below the top part. I know the first row and find the last row.
Here is the issue. There are 2 sheets in the work book that use this
function. When I hit Atl -> Ctrl -> Shift -> F9 it counts the colors
but puts the count the in both sheets instead of each sheet having
it's own count of the colors that are on it. I pasted the code below.
Please help I'm about to start pulling my hair out.
'counts colored cells in given range by color
Function CountProjects(RngColor As Range) As Integer
Dim Srow As Long 'Start Row
Dim Erow As Long 'End Row
Dim Crow As Long 'Current Row
Dim Cll As Range 'range of cells
Dim Clr As Long 'color
Dim Rng As Range 'range of cells to look at for
color
Dim xlCalc As XlCalculation
''''''''''''''''''''''''''''''''''
Dim savScrnUD As Boolean 'for speeding
up calculations '
savScrnUD = Application.ScreenUpdating 'only
'
Application.ScreenUpdating = False '
'
xlCalc = Application.Calculation '
'
Application.Calculation = xlCalculationManual
''''''''''''''''''''''''''''''''''
On Error GoTo CalcBack 'Error
Handler
With ActiveSheet
.DisplayPageBreaks = False
Erow = .Cells(.Rows.Count, "A").End(xlUp).Row 'Find last
record of data
End With
Clr = RngColor.Range("A1").Interior.Color 'color =
selected cell color
If ActiveSheet.Name = "AFESummaryRpt" Then
Srow = 13 'set start
row for AFESummaryRpt
' Sheets("AFESummaryRpt").Select
ElseIf ActiveSheet.Name = "AlignBudgetReport" Then
Srow = 9 ' set
start row for AlignBudgetReport
' Sheets("AlignBudgetReport").Select
End If
Set Rng = Range("A" & Srow & ":" & "O" & Erow) 'set cell
range for whichever sheet is active
For Each Cll In Rng 'loop thru
cells in range
If Cll.Interior.Color = Clr Then 'if cell
color matchs cell in range
CountProjects = CountProjects + 1 'add one
to count of colors
End If
Next Cll
CalcBack:
If Err Then MsgBox Err.Description 'If error messagebox error
description
Application.Calculation = xlCalc 'Set speed up options back
to normal
Application.ScreenUpdating = savScrnUD 'Set speed up options back
to normal
End Function