sparkytech
Board Regular
- Joined
- Mar 6, 2018
- Messages
- 96
- Office Version
- 365
- 2019
I have a worksheet containing a VBA generated GANTT chart. The data for the GANTT chart comes from another sheet and is dynamic, so the number of rows on the GANTT varies, as does the number of columns. There are "week start" dates on row 4 beginning at column J. How can I fill the columns with a pattern and draw a border around the entire column that contains data? Disclaimer: I didn't create this particular GANTT chart, and the VBA is by others, so I can't explain everything about it's function.
VBA Code:
Sub DrawScale()
Dim Ncolumns As Integer 'Number of columns of the scale
Dim StartDate As Long 'Start date for index
Dim EndDate As Long 'End date to find number of columns
Dim iCol As Integer 'Col index for for loop
Dim wkday As Integer 'Day of week for given date
Dim InDate As Long
Dim EndCol As Integer
EndDate = Sheet3.Cells(2, 2)
Ncolumns = 1
'Finds the number of columns needed based on whole weeks by adding 7 to the start limit
'until it exceeds the end limit
Do Until EndDate >= Sheet3.Cells(2, 3)
EndDate = EndDate + 7
Ncolumns = Ncolumns + 1
Loop
'Find the first day of the week for the start of the column labels
wkday = Weekday(Sheet3.Cells(2, 2))
StartDate = Sheet3.Cells(2, 2) - wkday + 1
InDate = StartDate
EndCol = 9 + Ncolumns
'Label each of the columns with the first date of that week and format as short dates
For iCol = 10 To EndCol
Sheet3.Cells(4, iCol) = InDate
Sheet3.Cells(4, iCol).NumberFormat = "m/d/yy"
InDate = InDate + 7
Sheet3.Cells(4, iCol).Orientation = 90
Next iCol
End Sub
Sub PickColor(CRow)
'Checks to see if a color has been assigned to a TCR; if one has been assigned it matches that color
'If not a random color will be generated and applied.
Dim r As Byte
Dim g As Byte
Dim b As Byte
Dim bR As Long 'Bottom row of table
Dim lC As Long 'Last column of table
Dim indRow As Integer
Dim TempNo As Long
'Find the bottom row and last column of the table
bR = Sheet3.Cells.Find(What:="*", After:=Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
lC = Sheet3.Cells.Find(What:="*", After:=Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column
'bnewport commented out ~ Find three random numbers to change the cell colors later
'r = WorksheetFunction.RandBetween(0, 255)
'g = WorksheetFunction.RandBetween(0, 255)
'b = WorksheetFunction.RandBetween(0, 255)
'bnewport added ~ Find three random numbers to change the cell colors later ~ LIMIT TO PASTELS
r = WorksheetFunction.RandBetween(128, 255)
g = WorksheetFunction.RandBetween(128, 255)
b = WorksheetFunction.RandBetween(128, 255)
'Establish the first row to start - using 5 to skip all the titles
indRow = 5
'Checks all of the rows above the row that comes in as variable
Do Until indRow > CRow
'If the cell of the indRow does not have a color then the random color is assigned to the row to be colored
'if the indRow cell does have color and if the TCR name is the same then the color of the indRow is applied
'to the row that is to be colored
If Sheet3.Cells(indRow, 1).Interior.ColorIndex = xlNone Then
Sheet3.Cells(CRow, 1).Interior.Color = RGB(r, g, b)
ElseIf Sheet3.Cells(CRow, 2) = Sheet3.Cells(indRow, 2) Then
Sheet3.Cells(CRow, 1).Interior.Color = Sheet3.Cells(indRow, 1).Interior.Color
End If
indRow = indRow + 1
Loop
End Sub
Sub DrawOneRow(DRow)
'Draws a single row of the Gantt chart based on the project start date and end date
'Must be run after PickColor to have a color assigned to that row.
Dim bR As Long 'Bottom row of table
Dim lC As Long 'Last column of table
Dim indCol As Integer
'Find the bottom row and last column of the table
bR = Sheet3.Cells.Find(What:="*", After:=Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
lC = Sheet3.Cells.Find(What:="*", After:=Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column
For indCol = 11 To lC
If Sheet3.Cells(4, indCol) >= Sheet3.Cells(DRow, 7) And Sheet3.Cells(DRow, 8) >= Sheet3.Cells(4, indCol) Then
Sheet3.Cells(DRow, indCol).Interior.Color = Sheet3.Cells(DRow, 1).Interior.Color
End If
Next indCol
End Sub
Sub DrawItAll()
'Draws the scale, assigns colors and draws all the rows of the Gantt Chart
Dim bR As Long 'Bottom row of table
Dim lC As Long 'Last column of table
Dim inRow As Integer
'Find the bottom row and last column of the table
bR = Sheet3.Cells.Find(What:="*", After:=Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
lC = Sheet3.Cells.Find(What:="*", After:=Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column
'Turn off screen updates to improve performance
Application.ScreenUpdating = False
Call DrawScale
For inRow = 5 To bR
Call PickColor(inRow)
Call DrawOneRow(inRow)
Next inRow
Call GanttAsTable.CreateTable
'Turn on screen updates
Application.ScreenUpdating = True
End Sub