VBA Count most current 6 months

J

Jane

This is going to be complicated for me to explain. After my explanation I am
pasting in previous code that you all so graciously helped me with a while
back.

In Cell R1 I have "# of sales last 6 months" In that column using similar
criteria as shown below I need to be able to count the number of cells in
rows F-Q (Jul-Jun) that have a number in it but only if it is in the most
recent 6 months (and then to color code it based on the count or tl price.
Cell A3 is the month calculation but set for the previous month so for
instance in Feb, When I open my spreadsheet I want it to automatically count
the # of cells in each row from Aug-Jan. Then in Mar it will automatically
count the cells from Sep-Feb. and count and color code the corresponding cell
in the same row in column R. I need to incorporate this into what I have
below as it is in the same worksheet. Thanks in advance for your help.



Sub ColorFormat(sh As Worksheet)
sh.Activate

Dim Rng As Range, cell As Range
Dim ncol As Integer, lrow As Long
Dim pcnt As Double, divisor As Double
Dim MyCell As Range

' Find column for current Month (add 5 to start in colum F onwards)
' Define "CurMonth" and "HdrMonths" in spreadsheet
ncol = Application.WorksheetFunction.Match(Range("A3"), Range("F3:Q3"), 0) + 5

' Find last row of data in current month column
lrow = Cells(Rows.Count, 1).End(xlUp).Row

'Range("F9:Q500").Select
'Clears the colours
'Selection.Interior.ColorIndex = xlNone

For Each MyCell In Range("F9:Q500")
Select Case MyCell.Interior.ColorIndex
'bright green
Case Is = 4
MyCell.Interior.ColorIndex = xlNone
'light green
Case Is = 35
MyCell.Interior.ColorIndex = xlNone
'light yellow
Case Is = 36
MyCell.Interior.ColorIndex = xlNone
'pink
Case Is = 7
MyCell.Interior.ColorIndex = xlNone
'red
Case Is = 3
MyCell.Interior.ColorIndex = xlNone
End Select
Next MyCell

' Set range to cells for current month (WHICH IS CELL A3) starting row 20
Set Rng = Range(Cells(20, ncol), Cells(lrow, ncol))

' Set Divisor for current month
divisor = Cells(5, ncol)

' Loop through all cells in range
For Each cell In Rng

' Check length of cell in column A
If Len(cell.Offset(0, -(ncol - 1))) = 4 Then
' Calculate perecentage
If Application.IsNumber(cell) Then ' Is this cell a number ?

' Calculate percentage
pcnt = (cell / divisor) * 100
cell.Select
' Set colorindex based on percentage
Select Case pcnt
Case Is > 100
Selection.Interior.ColorIndex = 4
Case Is >= 90
Selection.Interior.ColorIndex = 35
Case Is >= 80
Selection.Interior.ColorIndex = 36
Case Is >= 1
Selection.Interior.ColorIndex = 7
Case Else
Selection.Interior.ColorIndex = 3
End Select

' This colors the blank empty cells
Else
cell.Select
Selection.Interior.ColorIndex = 3

End If
End If
Next cell

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top