software

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 -gt; Ctrl -gt; Shift -gt; 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, quot;Aquot;).End(xlUp).Row 'Find last
record of data
End With

Clr = RngColor.Range(quot;A1quot;).Interior.Color 'color =
selected cell color
If ActiveSheet.Name = quot;AFESummaryRptquot; Then
Srow = 13 'set start
row for AFESummaryRpt
' Sheets(quot;AFESummaryRptquot;).Select
ElseIf ActiveSheet.Name = quot;AlignBudgetReportquot; Then
Srow = 9 ' set
start row for AlignBudgetReport
' Sheets(quot;AlignBudgetReportquot;).Select
End If

Set Rng = Range(quot;Aquot; amp; Srow amp; quot;:quot; amp; quot;Oquot; amp; 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 CllCalcBack:
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 FunctionInstead of referencing ActiveSheet (either explicitly or impltly), you should reference Applicaion.Caller.Worksheet

HTH
--
AP

'--------------------------------------
'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 Application.Caller.Worksheet
.DisplayPageBreaks = False
Erow = .Cells(.Rows.Count, quot;Aquot;).End(xlUp).Row 'Find last record of data
End With

Clr = RngColor.Range(quot;A1quot;).Interior.Color 'color =selected cell color
If Application.Caller.Worksheet.Name = quot;AFESummaryRptquot; Then
Srow = 13 'set startrow for AFESummaryRpt
' Sheets(quot;AFESummaryRptquot;).Select
ElseIf Application.Caller.Worksheet.Name = quot;AlignBudgetReportquot; Then
Srow = 9 ' set start row for AlignBudgetReport
' Sheets(quot;AlignBudgetReportquot;).Select
End If

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

Also posted in public.excelquot;Johnquot; gt; wrote in message oups.com...
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 -gt; Ctrl -gt; Shift -gt; 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, quot;Aquot;).End(xlUp).Row 'Find last
record of data
End With

Clr = RngColor.Range(quot;A1quot;).Interior.Color 'color =
selected cell color
If ActiveSheet.Name = quot;AFESummaryRptquot; Then
Srow = 13 'set start
row for AFESummaryRpt
' Sheets(quot;AFESummaryRptquot;).Select
ElseIf ActiveSheet.Name = quot;AlignBudgetReportquot; Then
Srow = 9 ' set
start row for AlignBudgetReport
' Sheets(quot;AlignBudgetReportquot;).Select
End If

Set Rng = Range(quot;Aquot; amp; Srow amp; quot;:quot; amp; quot;Oquot; amp; 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 CllCalcBack:
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 FunctionThanks alot I think that got it.

John