Optimize WORD VBA - If, Case
I implemented this following code to go though 11 dropdown content controls to color 2 cells in a WORD table based on the user entries - RED, YELLOW, GREEN, and no entry.
This seems to slow down the loading of the document quite a bit - is there a way to either optimize the code or only compute it after the document is closed? Ideally it would be the first option.
Option Explicit
Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
If ContentControl.Tag = "status_1" Then
Select Case ContentControl.Range.Text
Case "GREEN"
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(0, 255, 0)
ActiveDocument.Tables(2).Tables(1).Cell(2, 1).Shading.BackgroundPatternColor = RGB(0, 255, 0)
Case "YELLOW"
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 255, 0)
ActiveDocument.Tables(2).Tables(1).Cell(2, 1).Shading.BackgroundPatternColor = RGB(255, 255, 0)
Case "RED"
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 0, 0)
ActiveDocument.Tables(2).Tables(1).Cell(2, 1).Shading.BackgroundPatternColor = RGB(255, 0, 0)
Case Else
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(100, 50, 150)
ActiveDocument.Tables(2).Tables(1).Cell(2, 1).Shading.BackgroundPatternColor = RGB(100, 50, 150)
End Select
End If
If ContentControl.Tag = "status_2" Then
Select Case ContentControl.Range.Text
Case "GREEN"
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(0, 255, 0)
ActiveDocument.Tables(2).Tables(1).Cell(3, 1).Shading.BackgroundPatternColor = RGB(0, 255, 0)
Case "YELLOW"
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 255, 0)
ActiveDocument.Tables(2).Tables(1).Cell(3, 1).Shading.BackgroundPatternColor = RGB(255, 255, 0)
Case "RED"
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 0, 0)
ActiveDocument.Tables(2).Tables(1).Cell(3, 1).Shading.BackgroundPatternColor = RGB(255, 0, 0)
Case Else
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(100, 50, 150)
ActiveDocument.Tables(2).Tables(1).Cell(3, 1).Shading.BackgroundPatternColor = RGB(100, 50, 150)
End Select
End If
If ContentControl.Tag = "status_3" Then
Select Case ContentControl.Range.Text
Case "GREEN"
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(0, 255, 0)
ActiveDocument.Tables(2).Tables(1).Cell(4, 1).Shading.BackgroundPatternColor = RGB(0, 255, 0)
Case "YELLOW"
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 255, 0)
ActiveDocument.Tables(2).Tables(1).Cell(4, 1).Shading.BackgroundPatternColor = RGB(255, 255, 0)
Case "RED"
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 0, 0)
ActiveDocument.Tables(2).Tables(1).Cell(4, 1).Shading.BackgroundPatternColor = RGB(255, 0, 0)
Case Else
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(100, 50, 150)
ActiveDocument.Tables(2).Tables(1).Cell(4, 1).Shading.BackgroundPatternColor = RGB(100, 50, 150)
End Select
End If
If ContentControl.Tag = "status_4" Then
Select Case ContentControl.Range.Text
Case "GREEN"
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(0, 255, 0)
ActiveDocument.Tables(2).Tables(1).Cell(5, 1).Shading.BackgroundPatternColor = RGB(0, 255, 0)
Case "YELLOW"
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 255, 0)
ActiveDocument.Tables(2).Tables(1).Cell(5, 1).Shading.BackgroundPatternColor = RGB(255, 255, 0)
Case "RED"
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 0, 0)
ActiveDocument.Tables(2).Tables(1).Cell(5, 1).Shading.BackgroundPatternColor = RGB(255, 0, 0)
Case Else
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(100, 50, 150)
ActiveDocument.Tables(2).Tables(1).Cell(5, 1).Shading.BackgroundPatternColor = RGB(100, 50, 150)
End Select
End If
If ContentControl.Tag = "status_5" Then
Select Case ContentControl.Range.Text
Case "GREEN"
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(0, 255, 0)
ActiveDocument.Tables(2).Tables(1).Cell(6, 1).Shading.BackgroundPatternColor = RGB(0, 255, 0)
Case "YELLOW"
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 255, 0)
ActiveDocument.Tables(2).Tables(1).Cell(6, 1).Shading.BackgroundPatternColor = RGB(255, 255, 0)
Case "RED"
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 0, 0)
ActiveDocument.Tables(2).Tables(1).Cell(6, 1).Shading.BackgroundPatternColor = RGB(255, 0, 0)
Case Else
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(100, 50, 150)
ActiveDocument.Tables(2).Tables(1).Cell(6, 1).Shading.BackgroundPatternColor = RGB(100, 50, 150)
End Select
End If
If ContentControl.Tag = "status_6" Then
Select Case ContentControl.Range.Text
Case "GREEN"
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(0, 255, 0)
ActiveDocument.Tables(2).Tables(1).Cell(7, 1).Shading.BackgroundPatternColor = RGB(0, 255, 0)
Case "YELLOW"
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 255, 0)
ActiveDocument.Tables(2).Tables(1).Cell(7, 1).Shading.BackgroundPatternColor = RGB(255, 255, 0)
Case "RED"
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 0, 0)
ActiveDocument.Tables(2).Tables(1).Cell(7, 1).Shading.BackgroundPatternColor = RGB(255, 0, 0)
Case Else
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(100, 50, 150)
ActiveDocument.Tables(2).Tables(1).Cell(7, 1).Shading.BackgroundPatternColor = RGB(100, 50, 150)
End Select
End If
If ContentControl.Tag = "status_7" Then
Select Case ContentControl.Range.Text
Case "GREEN"
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(0, 255, 0)
ActiveDocument.Tables(2).Tables(3).Cell(2, 1).Shading.BackgroundPatternColor = RGB(0, 255, 0)
Case "YELLOW"
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 255, 0)
ActiveDocument.Tables(2).Tables(3).Cell(2, 1).Shading.BackgroundPatternColor = RGB(255, 255, 0)
Case "RED"
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 0, 0)
ActiveDocument.Tables(2).Tables(3).Cell(2, 1).Shading.BackgroundPatternColor = RGB(255, 0, 0)
Case Else
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(100, 50, 150)
ActiveDocument.Tables(2).Tables(3).Cell(2, 1).Shading.BackgroundPatternColor = RGB(100, 50, 150)
End Select
End If
If ContentControl.Tag = "status_8" Then
Select Case ContentControl.Range.Text
Case "GREEN"
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(0, 255, 0)
ActiveDocument.Tables(2).Tables(3).Cell(3, 1).Shading.BackgroundPatternColor = RGB(0, 255, 0)
Case "YELLOW"
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 255, 0)
ActiveDocument.Tables(2).Tables(3).Cell(3, 1).Shading.BackgroundPatternColor = RGB(255, 255, 0)
Case "RED"
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 0, 0)
ActiveDocument.Tables(2).Tables(3).Cell(3, 1).Shading.BackgroundPatternColor = RGB(255, 0, 0)
Case Else
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(100, 50, 150)
ActiveDocument.Tables(2).Tables(3).Cell(3, 1).Shading.BackgroundPatternColor = RGB(100, 50, 150)
End Select
End If
If ContentControl.Tag = "status_9" Then
Select Case ContentControl.Range.Text
Case "GREEN"
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(0, 255, 0)
ActiveDocument.Tables(2).Tables(3).Cell(4, 1).Shading.BackgroundPatternColor = RGB(0, 255, 0)
Case "YELLOW"
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 255, 0)
ActiveDocument.Tables(2).Tables(3).Cell(4, 1).Shading.BackgroundPatternColor = RGB(255, 255, 0)
Case "RED"
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 0, 0)
ActiveDocument.Tables(2).Tables(3).Cell(4, 1).Shading.BackgroundPatternColor = RGB(255, 0, 0)
Case Else
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(100, 50, 150)
ActiveDocument.Tables(2).Tables(3).Cell(4, 1).Shading.BackgroundPatternColor = RGB(100, 50, 150)
End Select
End If
If ContentControl.Tag = "status_10" Then
Select Case ContentControl.Range.Text
Case "GREEN"
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(0, 255, 0)
ActiveDocument.Tables(2).Tables(3).Cell(5, 1).Shading.BackgroundPatternColor = RGB(0, 255, 0)
Case "YELLOW"
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 255, 0)
ActiveDocument.Tables(2).Tables(3).Cell(5, 1).Shading.BackgroundPatternColor = RGB(255, 255, 0)
Case "RED"
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 0, 0)
ActiveDocument.Tables(2).Tables(3).Cell(5, 1).Shading.BackgroundPatternColor = RGB(255, 0, 0)
Case Else
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(100, 50, 150)
ActiveDocument.Tables(2).Tables(3).Cell(5, 1).Shading.BackgroundPatternColor = RGB(100, 50, 150)
End Select
End If
If ContentControl.Tag = "status_11" Then
Select Case ContentControl.Range.Text
Case "GREEN"
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(0, 255, 0)
ActiveDocument.Tables(2).Tables(3).Cell(6, 1).Shading.BackgroundPatternColor = RGB(0, 255, 0)
Case "YELLOW"
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 255, 0)
ActiveDocument.Tables(2).Tables(3).Cell(6, 1).Shading.BackgroundPatternColor = RGB(255, 255, 0)
Case "RED"
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 0, 0)
ActiveDocument.Tables(2).Tables(3).Cell(6, 1).Shading.BackgroundPatternColor = RGB(255, 0, 0)
Case Else
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(100, 50, 150)
ActiveDocument.Tables(2).Tables(3).Cell(6, 1).Shading.BackgroundPatternColor = RGB(100, 50, 150)
End Select
End If
End Sub
Your code is very voluminous, so may take a long time to compile on loading the document.
If I understood the code correctly,
you have basically duplicated the same code under several IF tests,
where the only difference is the index: Cell(2, 1)
,
Cell(3, 1)
etc. and that of the table.
I suggest using variables for the cell and table indexes and writing the code only once, similar to the following (untested) code:
icell = 0
itable = 0
Select Case ContentControl.Range.Text
Case "status_1"
icell = 2
itable = 1
Case "status_2"
icell = 3
itable = 1
... etc ...
Case "status_11"
icell = 6
itable = 3
End Select
If icell <> 0
Select Case ContentControl.Range.Text
Case "GREEN"
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(0, 255, 0)
ActiveDocument.Tables(2).Tables(itable).Cell(icell, 1).Shading.BackgroundPatternColor = RGB(0, 255, 0)
Case "YELLOW"
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 255, 0)
ActiveDocument.Tables(2).Tables(itable).Cell(icell, 1).Shading.BackgroundPatternColor = RGB(255, 255, 0)
Case "RED"
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 0, 0)
ActiveDocument.Tables(2).Tables(itable).Cell(icell, 1).Shading.BackgroundPatternColor = RGB(255, 0, 0)
Case Else
ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(100, 50, 150)
ActiveDocument.Tables(2).Tables(itable).Cell(icell, 1).Shading.BackgroundPatternColor = RGB(100, 50, 150)
End Select
End If
I haven't tested the above code.