Trying To Calculate YTD Percentage 1

[TheMus]

Hello,

I'm trying to setup code that will, when a spreadsheet is opened, go thru 12 sheets, specific cell ranges, find the number of cells that are not blank in the cell range and store that value in a variable. From the stored variable, I'll be able to determine how many I should divide by in my calculation to get an accurate YTD percentage.

Any ideas? I'm in over my head.

Thanks, Rus

 

[kevinclark]

Maybe there are easier ways but here are a couple ideas

This one counts Non-Blank Cells of all Sheets
----------------------------------------------------------
Private Sub Workbook_Open()
CountCells
End Sub

Public Sub CountCells()
Dim x As Integer
Dim c
Dim WS
x = 0
For Each WS In ActiveWorkbook.Sheets
'Adjust the range to suit your needs
For Each c In WS.Range("A1:A24&quot
If c.Value <> &quot;&quot; Then
x = x + 1
End If
Next c
Next WS
MsgBox x
End Sub
----------------------------------------------------------
If you want to have it count cells from specific sheets you can modify the above code to

a) Use a Like condition. This would work if you are using
a naming convention for the sheets.
Example: Data_1, Data_2, Data_3 etc

Public Sub CountCells()
Dim x As Integer
Dim c
Dim WS
x = 0
For Each WS In ActiveWorkbook.Sheets
'Adjust the Name Convention to suit your needs
If WS.Name Like &quot;Data_*&quot; Then
'Adjust the range to suit your needs
For Each c In WS.Range(&quot;A1:A24&quot
If c.Value <> &quot;&quot; Then
x = x + 1
End If
Next c
End If
Next WS
MsgBox x
End Sub

OR

b) Use an Array. Here you specify which sheets

Public Sub CountCells()
Dim WS
Dim c
Dim i As Integer
Dim x As Integer
'Change Array contents to suit your needs
WS = Array(&quot;Sheet1&quot;, &quot;Sheet2&quot;, &quot;Sheet3&quot
For i = 0 To UBound(WS)
'Adjust the range to suit your needs
For Each c In Sheets(WS(i)).Range(&quot;A1:A24&quot
If c.Value <> &quot;&quot; Then
x = x + 1
End If
Next c
Next i
MsgBox x
End Sub

---------------------------------------------------------

If you need to SUM the actual contents of Non-Blank cells then change the code from: x = x + 1 to read
x = x + c.value
Also if this is the case then you might want to add the line On Error Resume Next in case any cells were to contain non numeric values.

 

[TheMus]

Thanks for sharing your expertise Kevin. It's right on the money.

Rus

 

[TheMus]

Kevin,

The code is running through the process but it doesn't like to add up the values of the cells when they are formatted to percentages. How can I get the code to accept the percentages?

Rus

 

[kevinclark]

When you say it does not like to add the cells I take it to mean that if you had two cells, one that shows 34% and the other showing 56% you get an answer like 1 ?

This is because the percentage is equal to a decimal value and Integers will not display decimal values. Instead it will round to closest whole number. Therefore the value .9 will be returned as a 1.

To solve this problem you need simply change the line that
reads Dim x As Integer to Dim X As Double
Double will return decimal values.

Note: I also assume that you will need to calculate the average of these values / percentages. I have added the code below to show how I did it.


Public Sub CountCells()
Dim x As Double
Dim z As Integer
Dim c
Dim WS
x = 0
z = 0
For Each WS In ActiveWorkbook.Sheets
'Adjust the range to suit your needs
For Each c In WS.Range(&quot;A1:A24&quot
If c.Value <> &quot;&quot; Then
x = x + c.Value
z = z + 1
End If
Next c
Next WS
MsgBox &quot;Average is &quot; & (x / z) * 100 & &quot; %&quot;
End Sub