Expand on current VBA procedure

[pbt]

Hi folks,

I have the follwing code that will turn the ajoining cell to a particular color based on the Month of a date that is formated 1/12/06.

I need to expand on this code so it will also look at the Year. This spreedsheet will run into the next year so just looking at the month will not do. Of course I would change the color index for the next year to something else.

Sub ColorByMonth()
    Dim rCell As Range
    Application.ScreenUpdating = False
    Application.Calculate
    On Error GoTo Xit
    For Each rCell In Range("j2:j" & Range("j65536").End(xlUp).Row)
        Select Case Month(rCell)
            Case 1
                rCell.Offset(0, 1).Interior.ColorIndex = 36
            Case 2
                rCell.Offset(0, 1).Interior.ColorIndex = 42
            Case 3
                rCell.Offset(0, 1).Interior.ColorIndex = 39

This continues for all twelve months (Case 12)

Any help would be greatly appreciated.

Thanks
h.h.

 

[pbt]

I like how this works now. It changes the colors instantly and I don't have to assign the code to a button for activation (like I had originally)

Couple problems though:

1. Column "U" is a hard entered date which will be a different month date then the other two columns which are formulas based on the date entered in "I". example: =I2+3 or =I2+10
Right now "U" will not pickup a color change unless I close the book & reopen it. First two columns work just fine, even if the formula adds days that run into the next month.

2. My UDF's that sum by color, on another sheet do not work now. The only way I can get them to work is click on the formula bar and hit enter, or do a Save As with a different name.

h.h.

 

[jindon]

Harry,

Is Calcltion mode set to automatic?

UDF with color usually doesn't pick up the change automatically,
therefore, you need to re-calculate the sheet(hit F9)

And make sure that your UDF has a line of
Application.Volatile

If you change the column U, then Change event should be triggered....

 

[pbt]

Jindon

Workbook is set to automatic. After a date change(& color change), F9 does not calculate sheet.

Entry in "U" does not change the ajoining cell color. What is driving the color change for "V" is date in "J". Of course if "J" is Jan and "U" is Feb, "V" will pick up Feb's color, not Jan's color. But this will not happen unless I close & reopen.

I had taken out the Volatile statement in the UDF in my original code prior to you and I working on this additional enhancement. The reason I took it out was for every keystroke the sheet would go into Calculation mode. The was a problem because the sheet has about 1000 rows and it just took to long for the cursor to move to the next cell after input. And the only column that one of the users will be doing input is in column "I". He would have to wit a good 5 to 7 seconds for the cursor to move.

I tried the Volatile with your code ~ same thing happens, takes to long to calculate.

h.h.

 

[jindon]

OK
Will you please post your current code?

 

[pbt]

Sub test()
Dim r As Range, myCol, i As Integer
myCol = Array("j", "p", "u")
For i = 0 To UBound(myCol)
     For Each r In Range(myCol(i) & "2", Range(myCol(i) & Rows.Count).End(xlUp))
          If IsDate(r.Value) Then
              Select Case Month(r.Value)
                   Case 1: myColor = 7
                   Case 2: myColor = 13
                   Case 3: myColor = 16
                   Case 4: myColor = 19
                   Case 5: myColor = 23
                   Case 6: myColor = 27
                   Case 7: myColor = 30
                   Case 8: myColor = 35
                   Case 9: myColor = 39
                   Case 10: myColor = 41
                   Case 11: myColor = 44
                   Case 12: myColor = 47
               End Select
               If IsEmpty(myColor) Then
                      MsgBox ("something wrong in " & r.Address)
                      Exit Sub
               End If
               If Year(r.Value) <> 2006 Then myColor = myColor + 1
               r.Offset(, 1).Interior.ColorIndex = myColor
               myColor = Empty
         End If
      Next
Next
End Sub

In standard module

Private Sub Worksheet_Change(ByVal Target As Range)
With Target
     If .Count > 1 Then Exit Sub
     If Intersect(.Cells, Range("u:u")) Is Nothing Then Exit Sub
     If .Row > 1 Then Exit Sub
     If Not IsDate(.Cells) Then Exit Sub
End With
     Application.EnableEvents = False
     test
     Application.EnableEvents = True
End Sub

Private Sub Worksheet_Calculate()
Application.EnableEvents = False
test
Application.EnableEvents = True
End Sub

In sheet module

Function SumByColor(InRange As Range, WhatColorIndex As Integer, _
    Optional OfText As Boolean = False) As Double
'
' This function return the SUM of the values of cells in
' InRange with a background color, or if OfText is True a
' font color, equal to WhatColorIndex.
'
Dim Rng As Range
Dim OK As Boolean

For Each Rng In InRange.Cells
    If OfText = True Then
        OK = (Rng.Font.ColorIndex = WhatColorIndex)
    Else
        OK = (Rng.Interior.ColorIndex = WhatColorIndex)
    End If
    If OK And IsNumeric(Rng.Value) Then
        SumByColor = SumByColor + Rng.Value
    End If
Next Rng

End Function

UDF ~~~~ I had Application.Volatile after Dim OK As Boolean.

 

[jindon]

1) You can only re-calculate this UDF by F9 with Application.Volatile
recomendation:
As the condition of changing color is quite obvious, you can replace the formula without UDF..

2) Big mistake in Change event!

Please change the line to

If .Row < 1 Then Exit Sub

instead of > 1 Then Exit Sub

 

[pbt]

Problem solved for "U"

2) Big mistake in Change event!

Changed as suggested, works fine. Thank you

Now for number 1)

1) You can only re-calculate this UDF by F9 with Application.Volatile

If you recall in my first few post, the way that I had the code did not require Volatile to make it work.

I don't know if it has something to do with the code you wrote that are now in the Sheet module. But using Voliatile will be a bummer for the user to have to wait for every cell entry until the sheet finishes calculating.

recomendation:
As the condition of changing color is quite obvious, you can replace the formula without UDF..

If you are talking about something like this as a formula instead of a UDF:
=K2+K4+K7+K9+K12...so on and so on, picking out the colors in that row.

This is out of the question because there are over a 1000 rows and there is to much chance for human error.

In fact this is how the sheet was being done before the boss asked me to get rid of the human error.

Following is a sample of the sheet that has the UDF's:

SCSP 2006 FORECAST test 7.xls
	A	B	C	D
1	JANAURY	LH	ST	RETENTION
2	DELWEBBSUNCITY	11,280.40	18,023.00	3,803.80
3	FUTURE1
4	FUTURE2
5	TOTAL
6	FEBRUARY
7	DELWEBBSUNCITY	5,983.00	0.00	1,823.15
8	FUTURE1
9	FUTURE2
10	TOTAL
11	MARCH
12	DELWEBBSUNCITY	5,125.20	10,348.00	0.00
13	FUTURE1
14	FUTURE2
15	TOTAL
RECAP 2006

This is just a sample of three months. I have all twelve months, so the UDF is working in 36 cells, times two, because I have a sheet for 2007, total 72 cells.

Any ideas ? ? ?

h.h.

 

[jindon]

Sounds like..

=sumproduct(((Year(WEBB!$K$2:$K$1470)=2006)*(Month(WEB!$K$2:$K$1470)=1)),WEB!$K$2:$K$1470)

where 2007 and 1 should be changed

 

[pbt]

Formula contains an error when Enter is hit.

I fixed the spelling, that is not the problem.
Also double cheked placement of every (((
I also removed all UDF's and the UDF module

Don't quite understand the formula to figure out the error

h.h.

 

[jindon]

try

=Sum(If(Year(WEBB!$J$2:$J$1470)=2006,If(Month(WEB!$J$2:$J$1470)=1,WEB!$K$2:$K$1470)))

confirm with Ctrl + Shift + Enter