Change color according with dropdown selection

macropod · #31 03-14-2018, 02:24 PM

Your code's main Select Case statement is all wrong. You shouldn't have all those:

End Select
Select Case .Title
line pairs. You could also re-code the sub so the protection is processed only once. Similarly, where you don't change the font attributes for a given dropdown, there's no point having:
.Font.ColorIndex = wdAuto
for any of them, let alone all. You have again 'created' your own BackgroundPatternColorIndex - there is no such thing as 'Red'; it's wdRed. Basic coding errors of this kind would be trapped if you added:
Option Explicit
to the top of the code module.

The problems with "Unsatisfactory" and "Adequate" are most likely because what you're testing is not exactly the same as the dropdown selection. I also can't see the point of having BackgroundPatternColorIndex for your "Schedule", "GM" & "Cash" cases, as they effectively all produce the same output.

As for the document being 'frozen', your code applies 'filling in forms' protection once one of the designated content controls is exited, regardless of whether that protection was applied beforehand. The freezing might also result from the code hanging due to such simple errors as 'Red'.

Try the following:

Code:

Private Sub Document_ContentControlOnExit(ByVal CCtrl As ContentControl, Cancel As Boolean)
Dim bProt As Long: Const StrPwd As String = "abc"
With CCtrl
  If (.Title <> "Finding") And (.Title <> "Finding") And (.Title <> "Schedule") And (.Title <> "GM") And (.Title <> "Cash") Then Exit Sub
  With ActiveDocument
    bProt = .ProtectionType
    If bProt <> wdNoProtection Then .Unprotect Password:=StrPwd
  End With
  Select Case .Title
    Case "Finding"
      With .Range
        Select Case .Text
          Case "A"
            .Cells(1).Shading.BackgroundPatternColorIndex = wdRed
          Case "B"
            .Cells(1).Shading.BackgroundPatternColor = RGB(255, 153, 0)
          Case "C"
            .Cells(1).Shading.BackgroundPatternColorIndex = wdYellow
          Case Else
            .Cells(1).Shading.BackgroundPatternColorIndex = wdNoHighlight
        End Select
      End With
    Case "Rating"
      With .Range
        Select Case .Text
          Case "Satisfactory"
            .Cells(1).Shading.BackgroundPatternColorIndex = wdBrightGreen
          Case "Adequate"
            .Cells(1).Shading.BackgroundPatternColorIndex = wdBrightYellow
          Case "Requires Improvement"
            .Cells(1).Shading.BackgroundPatternColor = RGB(255, 153, 0)
          Case "Unsatisfactory"
            .Cells(1).Shading.BackgroundPatternColorIndex = wdRed
          Case Else
            .Cells(1).Shading.BackgroundPatternColorIndex = wdNoHighlight
        End Select
      End With
    Case "Schedule"
      With .Range
        Select Case .Text
          Case "No"
            .Font.ColorIndex = wdRed
          Case Else
            .Font.ColorIndex = wdAuto
        End Select
      End With
    Case "GM"
      With .Range
        Select Case .Text
          Case "Lower than ORA"
            .Font.ColorIndex = wdRed
          Case Else
            .Font.ColorIndex = wdAuto
        End Select
      End With
    Case "Cash"
      With .Range
        Select Case .Text
          Case "Negative"
            .Font.ColorIndex = wdRed
          Case Else
            .Font.ColorIndex = wdAuto
        End Select
      End With
  End Select
End With
If bProt <> wdNoProtection Then ActiveDocument.Protect bProt, True, StrPwd
End Sub

anakuprava · #32 03-14-2018, 05:09 PM

Code is working but entire file is still frozen..
How can I remove the protection you mentioned? I want to have these dropdowns in the file and still be able to edit the rest of the document. Should the code you copied have already done that? I apologize for asking trivial questions, this is the first time I'm dealing with codes

and thanks for help!

Quote:

Originally Posted by macropod

Your code's main Select Case statement is all wrong. You shouldn't have all those:
End Select
Select Case .Title
line pairs. You could also re-code the sub so the protection is processed only once. Similarly, where you don't change the font attributes for a given dropdown, there's no point having:
.Font.ColorIndex = wdAuto
for any of them, let alone all. You have again 'created' your own BackgroundPatternColorIndex - there is no such thing as 'Red'; it's wdRed. Basic coding errors of this kind would be trapped if you added:
Option Explicit
to the top of the code module.

The problems with "Unsatisfactory" and "Adequate" are most likely because what you're testing is not exactly the same as the dropdown selection. I also can't see the point of having BackgroundPatternColorIndex for your "Schedule", "GM" & "Cash" cases, as they effectively all produce the same output.

As for the document being 'frozen', your code applies 'filling in forms' protection once one of the designated content controls is exited, regardless of whether that protection was applied beforehand. The freezing might also result from the code hanging due to such simple errors as 'Red'.

andreamills127 · #33 09-10-2018, 12:48 PM

Hi, I have just managed to colour code a drop down list in Word with a macro (even though I've never done anything like that before!) but can I have two different drop down lists (called different names) with different colour coding in the same document?

I used this for the first one:

Code:

Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
With ContentControl.Range
    If ContentControl.Title = "CC" Then
        Select Case .Text
            Case "NC"
                .Cells(1).Shading.BackgroundPatternColor = wdColorRed
            Case "OBS"
                .Cells(1).Shading.BackgroundPatternColor = wdColorLightOrange
            Case "GP"
                .Cells(1).Shading.BackgroundPatternColor = wdColorLime
            Case "REC"
                .Cells(1).Shading.BackgroundPatternColor = wdColorSkyBlue
            Case "NI"
                .Cells(1).Shading.BackgroundPatternColor = wdColorGray15
            Case Else
                .Cells(1).Shading.BackgroundPatternColor = wdColorAutomatic
        End Select
    End If
End With
End Sub

I've tried copying and pasting this into the same module and another one (changing the title name) but I'm obviously doing something wrong?

macropod · #34 09-10-2018, 02:55 PM

Your document description and your code are both for content controls, not formfields, so I've moved your post to a thread dealing with content controls.

Perhaps you could attach a document to a post with some representative data (delete anything sensitive) so we can see what the issue might be there? You do this via the paperclip symbol on the 'Go Advanced' tab at the bottom of this screen.

Note: Some of your colour designations, as creative as they are, are entirely invalid (i.e. they don't exist). You can't go making up your own colour names willy-nilly; you can only use the ones that Word provides.

andreamills127 · #35 09-11-2018, 09:12 AM

Hi Macropod, thank you for replying.

Apologies for putting the question on the wrong thread, it's my first time on a forum!

I'm attaching the word document. The code below works fine for the drop down box called "CC" but I don't know how to do another set of code for the drop down box "Summary". Hope this makes sense. I do not really have an idea of how to do the second one but I have tried copying and pasting the same code (but edited to refer to "Summary") into the same screen as the first one and also into another module screen.

I didn't make up the colours but got them from here: https://github.com/OfficeDev/VBA-con...ration-word.md and they all seem to work fine

Maybe word is just interpreting them for me but they all come up as slightly different.

headlockpdp · #36 12-18-2018, 06:28 PM

Hello,

How do I set conditional formatting to highlight the entire row in a table?

My document has 4 columns. In one of the columns I have a drop down content control box that I would like to use in order to change the color fill for the entire row.

The code below only highlights that particular cell rather than the whole row:

Code:

Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
With ContentControl
  If Len(.Title) < 6 Then Exit Sub
  If Left(.Title, 6) = "Status" Then
    Select Case .Range.Text
      Case "COMPLETE": .Range.Cells(1).Shading.BackgroundPatternColorIndex = wdGreen
      Case "Pending": .Range.Cells(1).Shading.BackgroundPatternColorIndex = wdYellow
      Case Else: .Range.Cells(1).Shading.BackgroundPatternColorIndex = wdNoHighlight
    End Select
  End If
End With
End Sub

macropod · #37 12-18-2018, 06:32 PM

Simply change .Cells to .Rows

PS: When posting code, please use the code tags, indicated by the # button on the posting menu. Without them, your code loses much of whatever structure it had.

gmaxey · #38 12-18-2018, 08:15 PM

Paul,

Not very elegant but one may have to deal with merged cells:

Code:

Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
With ContentControl
  If Len(.Title) < 6 Then Exit Sub
  If Left(.Title, 6) = "Status" Then
    On Error GoTo Err_Merged
    Select Case .Range.Text
      Case "COMPLETE"
        .Range.Rows(1).Shading.BackgroundPatternColorIndex = wdGreen
      Case "Pending": .Range.Rows(1).Shading.BackgroundPatternColorIndex = wdYellow
      Case Else: .Range.Rows(1).Shading.BackgroundPatternColorIndex = wdNoHighlight
    End Select
  End If
End With
lbl_Exit:
  Exit Sub
Err_Merged:
  DealWithMergedCells ContentControl
End Sub

Sub DealWithMergedCells(oCC As ContentControl)
Dim oCellRef As Cell, oCell As Cell
  Set oCellRef = oCC.Range.Cells(1)
  Select Case oCC.Range.Text
    Case "COMPLETE"
      oCC.Range.Cells(1).Shading.BackgroundPatternColorIndex = wdGreen
    Case "Pending"
       oCC.Range.Cells(1).Shading.BackgroundPatternColorIndex = wdYellow
    Case Else
       oCC.Range.Cells(1).Shading.BackgroundPatternColorIndex = wdNoHighlight
  End Select
  For Each oCell In oCC.Range.Tables(1).Range.Cells
    If oCell.RowIndex = oCellRef.RowIndex Then
      oCell.Shading.BackgroundPatternColorIndex = oCC.Range.Cells(1).Shading.BackgroundPatternColorIndex
    End If
  Next
End Sub

macropod · #39 12-18-2018, 08:24 PM

Hi Greg,

Something like that should only be needed if there are vertically-merged cells, in which case, I'd suggest:

Code:

Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
Application.ScreenUpdating = False
Dim r As Long, TblCell As Cell, Clr As Long
With ContentControl
  If Left(.Title, 6) = "Status" Then
    Select Case .Range.Text
      Case "COMPLETE": Clr = wdGreen
      Case "Pending": Clr = wdYellow
      Case Else: Clr = wdNoHighlight
    End Select
    r = .Range.Cells(1).RowIndex
    With .Range.Tables(1).Range
      For Each TblCell In .Cells
        With TblCell
          If .RowIndex = r Then .Shading.BackgroundPatternColorIndex = Clr
        End With
      Next
    End With
  End If
End With
Application.ScreenUpdating = True
End Sub

gmaxey · #40 12-18-2018, 08:40 PM

Exactly +1

headlockpdp · #41 12-19-2018, 07:57 AM

Thank you for the help!

One last question, instead of a drop down menu, can I use a check box for conditional formatting? If checked, highlight row green. If not, no highlights.

macropod · #42 12-19-2018, 02:31 PM

Quote:

Originally Posted by headlockpdp

One last question, instead of a drop down menu, can I use a check box for conditional formatting? If checked, highlight row green. If not, no highlights.

Yes, you can do that, in which case it's simply a matter of testing the content control's checked state. For example, replace:

Code:

    Select Case .Range.Text
      Case "COMPLETE": Clr = wdGreen
      Case "Pending": Clr = wdYellow
      Case Else: Clr = wdNoHighlight
    End Select

with:

Code:

    Select Case .Checked
      Case True: Clr = wdGreen
      Case Else: Clr = wdNoHighlight
    End Select

tico22 · #43 07-31-2022, 03:02 AM

Great information here, thx a lot, especially @marcopod for sharing the examples.
I have one follow-up question: My goal is to have the coloring/change already displayed when the user selects a different option in the drop-down
=> trying to avoid the requirement to exit the control field

I here had some good first success using BeforeStoreUpdate instead of OnExit.

However, I seem to be out of luck with your example. My attempt:

Code:

'this works, but exiting is required
Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)

' this would not require exiting, but does not seem to be triggered
Private Sub Document_ContentControlBeforeStoreUpdate(ByVal ContentControl As ContentControl, Content As String)

Any ideas why the event Document_ContentControlBeforeStoreUpdate is not triggered?

macropod · #44 07-31-2022, 03:51 PM

I see you have posted the same question in: https://www.msofficeforums.com/word-...ell-table.html
Kindly don't ask the same question in multiple posts. Thread closed. You may continue your discussion in the other thread.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
block selection in dropdown list	Intruder	Excel	2	01-10-2013 10:20 AM
Dropdown selection value	coconutt	Word VBA	5	09-13-2012 05:23 PM
Change cell color when selection is made from a drop down list	fedcco	Excel	12	08-28-2012 10:43 PM
Autofill a form which is contingent on a dropdown selection.	biffle0764	Word	2	05-09-2012 12:54 PM
Change cell color everytime a value is selected in dropdown list	angelica_gloria	Excel	4	01-27-2012 06:47 PM