Creating Dynamic Shapes in Excel Macro

[aroig07]

Hello !!!! I have this code which creates a module based on values put in excel columns. Basically, I have the name of a division on column 2, an actual number of employees on column 3, a calculated need of employees on column 4, and the difference on column 5 which the box changes colors depending on the division between the actual and difference. It works perfectly as is and gives me exactly what I need, but I wanted to add another 2 columns which represent overtime (column 6) and the difference taking into account overtime (column 7). I am able to show the values in the boxes, but it is not formatting the overtime difference based on the colors like the difference in column 4. Here is my code, I was basically just replicating the same code for the OT gap but was not working. I have highlighted in blue the portions I added to my original code.

Sub readData()


Dim lastParent As Integer


Dim rowIndex As Integer
Dim colIndex As Integer
Dim rowLoc As Integer
Dim colPosBox As Integer
Dim boxcolor As String
Dim boxcolorH As String
boxcolorH = ""

rowLoc = 50
rowIndex = 2
lastParent = 50
Dim actualColumnIndex As Integer
Dim calculatedColumnIndex As Integer
Dim gapColumnIndex As Integer
Dim overtimeColumnIndex As Integer
Dim gapOTColumnIndex As Integer

colIndex = 1

Do While ThisWorkbook.Sheets("Data").Cells(1, colIndex).Value <> ""
If (ThisWorkbook.Sheets("Data").Cells(1, colIndex).Value = "ACTUAL") Then
actualColumnIndex = colIndex
ElseIf (ThisWorkbook.Sheets("Data").Cells(1, colIndex).Value = "CALCULATED") Then
calculatedColumnIndex = colIndex
ElseIf (ThisWorkbook.Sheets("Data").Cells(1, colIndex).Value = "GAP") Then
gapColumnIndex = colIndex
ElseIf (ThisWorkbook.Sheets("Data").Cells(1, colIndex).Value = "Overtime") Then
overtimeColumnIndex = colIndex
ElseIf (ThisWorkbook.Sheets("Data").Cells(1, colIndex).Value = "GAP OT") Then
gapOTColumnIndex = colIndex
End If
colIndex = colIndex + 1
Loop


Do While ThisWorkbook.Sheets("Data").Cells(rowIndex, 2).Value <> ""

If (ThisWorkbook.Sheets("Data").Cells(rowIndex, 1).Value = "PARENT") Then
lastParent = rowLoc
boxcolorH = "LIGHTB"
boxcolor = "LIGHTB"
Call createItems(boxcolorH, 10, rowLoc, 100, 25, Worksheets("Data").Cells(rowIndex, 2).text)
Else
boxcolorH = ""
boxcolor = ""
Call createItems(boxcolorH, 20, rowLoc, 100, 25, Worksheets("Data").Cells(rowIndex, 2).text)
End If

Call createItems(boxcolorH, 140, rowLoc, 75, 25, Worksheets("Data").Cells(rowIndex, 3).text)

colIndex = 4
colPosBox = 260
Do While ThisWorkbook.Sheets("Data").Cells(rowIndex, colIndex).Value <> ""

If (colIndex = gapColumnIndex) Then
If (Worksheets("Data").Cells(rowIndex, actualColumnIndex).Value <> 0) Then
NumberC = Abs(Worksheets("Data").Cells(rowIndex, gapColumnIndex).Value) / Worksheets("Data").Cells(rowIndex, actualColumnIndex).Value
Else
NumberC = 1
End If

If (NumberC > 0.3) Then
boxcolorH = "RED"
ElseIf (NumberC > 0.15) Then
boxcolorH = "YELLOW"
Else
boxcolorH = "GREEN"
End If
Else
boxcolorH = boxcolor
End If

Call createItems(boxcolorH, colPosBox, rowLoc, 75, 25, Worksheets("Data").Cells(rowIndex, colIndex).text)

colPosBox = colPosBox + 100
colIndex = colIndex + 1
Loop

Do While ThisWorkbook.Sheets("Data").Cells(rowIndex, colIndex).Value <> ""

If (colIndex = gapOTColumnIndex) Then
If (Worksheets("Data").Cells(rowIndex, actualColumnIndex).Value <> 0) Then
NumberO = Abs(Worksheets("Data").Cells(rowIndex, gapOTColumnIndex).Value) / Worksheets("Data").Cells(rowIndex, actualColumnIndex).Value
Else
NumberO = 1
End If

If (NumberO > 0.3) Then
boxcolorH = "RED"
ElseIf (NumberO > 0.15) Then
boxcolorH = "YELLOW"
Else
boxcolorH = "GREEN"
End If
Else
boxcolorH = boxcolor
End If

Call createItems(boxcolorH, colPosBox, rowLoc, 75, 25, Worksheets("Data").Cells(rowIndex, colIndex).text)

colPosBox = colPosBox + 100
colIndex = colIndex + 1
Loop

Set var1 = Worksheets("Output").Shapes.AddConnector(msoConnectorStraight, 15, rowLoc + (25 / 2), colIndex * 65, _
rowLoc + (25 / 2))

With var1.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 0, 0)
.Transparency = 0
End With
var1.ZOrder msoSendToBack

If (rowIndex = 2) Then
rowLoc = rowLoc + 5
End If
rowLoc = rowLoc + 30
rowIndex = rowIndex + 1

If (ThisWorkbook.Sheets("Data").Cells(rowIndex, 1).Value = "PARENT" Or ThisWorkbook.Sheets("Data").Cells(rowIndex, 2).Value = "") Then
Set var1 = Worksheets("Output").Shapes.AddConnector(msoConnectorStraight, 15, lastParent + (25 / 2), 15, _
rowLoc + (25 / 2) - 30)
var1.ZOrder msoSendToBac
With var1.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 0, 0)
.Transparency = 0
End With
var1.ZOrder msoSendToBack
rowLoc = rowLoc + 80
End If

Loop


End Sub



Here is the code also for the createitems sub:

Sub createItems(color As String, locX As Integer, locY As Integer, x As Integer, y As Integer, itemText As String)
' .Select
Set var1 = Worksheets("Output").Shapes.AddShape(msoShapeRectangle, locX, locY, x, y)
var1.ZOrder msoSendToFront
If (color = "RED") Then
With var1.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
.Solid
End With

ElseIf (color = "YELLOW") Then
With var1.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 255, 0)
.Transparency = 0
.Solid
End With

ElseIf (color = "GREEN") Then
With var1.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 176, 80)
.Transparency = 0
.Solid
End With
ElseIf (color = "LIGHTB") Then
With var1.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(231, 240, 245)
.Transparency = 0
.Solid
End With
Else
With var1.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0.6000000238
.Transparency = 0
.Solid
End With

End If

With var1.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 0, 0)
.Transparency = 0
End With
var1.TextFrame2.TextRange.Characters.text = itemText
var1.TextFrame2.TextRange.ParagraphFormat.Alignment = _
msoAlignCenter
With var1.TextFrame2.TextRange.Characters. _
ParagraphFormat
.FirstLineIndent = 0
.Alignment = msoAlignCenter
End With
With var1.TextFrame2.TextRange.Characters.Font
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorLight1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Fill.Solid
.Size = 11
.Name = "+mn-lt"
End With
With var1.TextFrame2.TextRange.Font.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorText2
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
.Transparency = 0
.Solid
End With
End Sub