Results 1 to 3 of 3
  1. #1
    Star Lounger
    Join Date
    Jun 2001
    Posts
    76
    Thanks
    0
    Thanked 0 Times in 0 Posts
    I think I have seen the answer to a similar question before here in the lounge, but cannot seem to get the search to turn up the results I am looking for.

    I have a project calendar that I would like to have colored based on a user-assigned color for each project. On the General_Info tab is the list of available projects along with a cell for the user to define the color for each. On the Detailed_Schedule tab are the project schedule details by location. What I would like to happen is:
    - User lists projects and assigns colors on General Info tab
    - User enters one or more project details on the Detailed_Schedule tab
    - User clicks Update Colors button (to run macro)
    - Macro would then shade/color each date cell between the start and end dates using the color assigned to that project

    See attached sample for an idea of what I was hoping to produce.
    Attached Files Attached Files

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts
    Here is such a macro:

    Code:
    Sub ColorIt()
      Dim wsh1 As Worksheet
      Dim wsh2 As Worksheet
      Dim r As Long
      Dim m As Long
      Dim t As Long
      Dim intColor As Integer
      Dim c1 As Long
      Dim c2 As Long
    
      Set wsh1 = Worksheets("General_Info")
      Set wsh2 = Worksheets("Detailed_Schedule")
      m = wsh2.Range("A2").End(xlDown).Row
      For r = 3 To m
    	t = wsh1.Range("A:A").Find(What:=wsh2.Range("A" & r), _
    	  LookIn:=xlValues, LookAt:=xlWhole).Row
    	intColor = wsh1.Range("C" & t).Interior.ColorIndex
    	c1 = wsh2.Rows(2).Find(What:=wsh2.Range("D" & r), _
    	  LookIn:=xlFormulas, LookAt:=xlWhole).Column
    	c2 = wsh2.Rows(2).Find(What:=wsh2.Range("E" & r), _
    	  LookIn:=xlFormulas, LookAt:=xlWhole).Column
    	wsh2.Range("F" & r & ":IP" & r).Interior.ColorIndex = xlColorIndexNone
    	wsh2.Range(wsh2.Cells(r, c1), wsh2.Cells(r, c2)).Interior.ColorIndex = intColor
      Next r
    End Sub

  3. #3
    Star Lounger
    Join Date
    Jun 2001
    Posts
    76
    Thanks
    0
    Thanked 0 Times in 0 Posts
    That is a beautiful thing - thank you so much.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •