Expand on current VBA procedure

P

pbt

Well-known Member
Joined
Oct 18, 2005
Messages
1,613
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.

Code: 
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.
 
Sort by date Sort by votes
Do you mean that you want to set the original color set to current year?

Then

If Year(r.Value) <> Year(Date) Then mycolor = mycolor + 1

Is this what you wanted?
 
Upvote 0

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
This is what I was thinking (and tried, but with no success)

Something to replace the 2006 in the code like TODAY() or NOW(), but still be able to pick up just the year

That way nobody has to go into the Editor to change a date

h.h.
 
Upvote 0
Your code in standard module should look like this

and if this doesn't work, would you tell me how you are entering the dates?
Code: 
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) <> Year(Date) Then myColor = myColor + 1
               r.Offset(, 1).Interior.ColorIndex = myColor
               myColor = Empty
         End If
      Next
Next
End Sub
 
Upvote 0
Sorry, I think you and I posted at the same time.

I tried your suggestion, had to change the date setting on my PC for testing.

I think we are done with this, finally,
I HOPE

I Truely appreciate all your help on this. It has been an ordeal working on a 16 hour time difference. And I tried real hard to let you get your sleep while I burnt the midnight oil to communicate.

And like I said, I am truely a novice at this(copy and paste from code left behind from a previous emmployee). But I have been amazed and enlightened by your expertise, being that you Excell has been down.

Now my task is to implement this into the other 3 states, which is going to be a task because each one is a little different. (No problem, I have the ground work :rolleyes: )

~~~~ Checked befor posting. Yes my code is the same way as your last post

Again, thank you very much
h.h.

P.S. phxsportz says it the best on this link. I agree whole heartedly
http://www.mrexcel.com/board2/viewtopic.php?t=218935

And yes, I know there is a Lounge for that (like erik.van.geit "realized" after posting.
 
Upvote 0
Great!

I suggest you to ask the better formula to the board, some guru like Aladdin may come to you with much better solution...
 
Upvote 0
I see what you mean.

Right now it refers to the year 2006 or 2007, but with the latest change to the code, the formula would have to change also.

Very good advice! I will wait (and monitor when Aladin is on line), since I know he is very good at formulas and probally can help if I don't figure it out. (I will try in the mean time)

If any time you are in Las Vegas, NV ~ shoot me a PM or e-mail. I owe you a drink at least, (beer, soda, or otherwise) or just to say thanks in person.

P.S. I'm trying to hit 10 pages of posts with no help from others, (800 views). (y)

Thanks again
h.h.
 
Upvote 0
In That part you can substitute with

=Year(Today())

<>Year(Today())

what I mean is other than array forumla....

and yes, I will when I happned to go there...
 
Upvote 0
You must log in or register to reply here.

Similar threads

O
  • Question
Frustrating intermittent VBA error dialog telling me that "User-define Type Not Defined"
Replies
1
Views
169
Micron
M
A
  • Question
VBA Show detail pivot table row
Replies
0
Views
263
AndreaJ
A
M
  • Solved
Help to exit VBA upon cancel on input box
Replies
3
Views
423
Domenic
D
B
  • Solved
Looking to expand tool to track vacation pro-rations
Replies
1
Views
236
bh24524
B
F
  • Question
Returning changed dynamically created textbox value to corresponding cell
Replies
2
Views
530
frateg8r
F

Forum statistics

Threads
1,221,621
Messages
6,160,879
Members
451,675
Latest member
Parlapalli

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top