Format Lists - Based on a Conditional

[sand60]

Hello to all,

Greetings!

I am learning how to use vba. So am very new.

I found this thread that highlights word.

Find and highlight first occurrence each word from list separate table

I am trying to adapt it to my situation, not sure if its the best approach but here goes.

What I am trying to do - search through my document and format the lists only.

Each list has a different first word color that needs to be applied.


Example

If the previous paragraph word is Blue : make all the first words in the list underneath blue

Blue


Apples - fruit
oranges - tasty
pears - delicious



Green


Island - nice
USA - party
Europe - place




If the previous paragraph word is green make all the first words in that list green and so on.

I couldn't think of a place holder so i though if the previous word is something do something.




Sub ListFirstWordsFormat()


Dim PreviousPara As Paragraph

Dim para As Paragraph

Dim list_item As Boolean

list_item = False


For Each para In ActiveDocument.Paragraphs

If para.Range.ListFormat.ListType = WdListType.wdListBullet Then

para.Range.Words(1).Font.Bold = True


Do While .Execute


'Select Case

Case 1: If PreviousPara = Black Then para.Range.Words(1).Font.Bold = True
Case 2: If PreviousPara = Blue Then para.Range.Words(1).Font.Bold.color = wdblue
Case 3: If PreviousPara = Green Then para.Range.Words(1).Font.Bold.color = wdgreen



End Select
oRng.Collapse wdCollapseEnd
If lngFound = lngCol Then Exit Do
Loop
End With



End If
Next

End Sub



I have a brief skeleton out line, but nothin cohesive,

I don't mind using a table to store the words if thats an option, or using more case statements.

Thank you very much for your consideration and advice

sand

[gmaxey]

Based on your example, then something like this:


Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oPar As Paragraph
Dim var(2, 1) 'Demension as appropriate
Dim lngIndex As Long
var(0, 0) = "Blue"
var(0, 1) = wdBlue
var(1, 0) = "Green"
var(1, 1) = wdGreen
var(2, 0) = "Red"
var(2, 1) = wdRed
For Each oPar In ActiveDocument.Paragraphs
If oPar.Range.ListFormat.ListType = wdListBullet Then
If Not oPar.Previous.Range.ListFormat.ListType = wdListBullet Then
For lngIndex = 0 To UBound(var, 1)
If Trim(oPar.Previous.Range.Words(1)) = var(lngIndex, 0) Then
oPar.Range.Words(1).Font.ColorIndex = var(lngIndex, 1)
Exit For
End If
Next lngIndex
Else
oPar.Range.Words(1).Font.ColorIndex = var(lngIndex, 1)
End If
End If
Next oPar
lbl_Exit:
Exit Sub

End Sub

[sand60]

Hi Greg,

thank you for your help.

This is great.

Worked like a charm.:yes


I had a follow up question - if I wanted to color the words before the first - hyphen dash would that be possible?

color everything before the - (hyphen)

apologies -I just realized the words may be more than one and a dash follows them

very grateful for your help

thank you for helping me again

sand

[gmaxey]

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oPar As Paragraph
Dim var(2, 1) 'Demension as appropriate
Dim lngIndex As Long
Dim oRng As Range
var(0, 0) = "Blue"
var(0, 1) = wdBlue
var(1, 0) = "Green"
var(1, 1) = wdGreen
var(2, 0) = "Red"
var(2, 1) = wdRed
For Each oPar In ActiveDocument.Paragraphs
If oPar.Range.ListFormat.ListType = wdListBullet Then
If Not oPar.Previous.Range.ListFormat.ListType = wdListBullet Then
For lngIndex = 0 To UBound(var, 1)
If Trim(oPar.Previous.Range.Words(1)) = var(lngIndex, 0) Then
Set oRng = oPar.Range.Words(1)
oRng.MoveEndUntil Cset:="-", Count:=wdForward
oRng.End = oRng.End - 1
oRng.Font.ColorIndex = var(lngIndex, 1)
Exit For
End If
Next lngIndex
Else
Set oRng = oPar.Range.Words(1)
oRng.MoveEndUntil Cset:="-", Count:=wdForward
oRng.End = oRng.End - 1
oRng.Font.ColorIndex = var(lngIndex, 1)
End If
End If
Next oPar
lbl_Exit:
Exit Sub

End Sub

[sand60]

Greg,

what an incredibly nice gentleman you are.

thanks for lending your coding intel,

in the interim i did try to update but failed spectacularly

I appreciate it - Great friend

I hope you have a nice day :grinhalo:

thank you again

Sand

[sand60]

Hi Greg,

I came up with this based on your ideas.

the code below works - I only added the external table

Column 1 holds the list color ie Green. Blue , Red ect
Column 2 - same word but it is colored to represent the words font color.


The problem - i do get erroneous coloring of ranges, it colors outside the ranges.


The macro should only color the first word untill the hyphen in each list.

Do i need to collapse a word range somewhere in the code so it wont color normal paragraphs outside the lists?

I wont speak any more as Its hard to explain, unless you run it.

I have been going round and round and cant seem to fix it.

cheers for your intel and any advice





Sub ColorListsFirstWordTable()

' Gregs Macros

Dim oDocSource As Document, oDoc As Document
Dim oTbl As Table
Dim oRng As Range
Dim lngIndex As Long
Set oDoc = ActiveDocument

Set oDocSource = Documents.Open(FileName:="C:\ListTable.docx", Visible:=False)

Set oTbl = oDocSource.Tables(1)
Set oRng = oDoc.Range
For Each oPar In ActiveDocument.Paragraphs
If oPar.Range.ListFormat.ListType = wdListBullet Then
If Not oPar.Previous.Range.ListFormat.ListType = wdListBullet Then

For lngIndex = 1 To oTbl.Rows.Count

If Trim(oPar.Previous.Range.Words(1)) = Left(oTbl.Cell(lngIndex, 1).Range.Text, Len(oTbl.Cell(lngIndex, 1).Range.Text) - 2) Then

Set oRng = oPar.Range.Words(1)
oRng.MoveEndUntil Cset:="-", Count:=wdForward
oRng.End = oRng.End - 1
oRng.Font.Color = oTbl.Cell(lngIndex, 2).Range.Font.Color


Exit For
End If
Next lngIndex


Else
Set oRng = oPar.Range.Words(1)
oRng.MoveEndUntil Cset:="-", Count:=wdForward
oRng.End = oRng.End - 1

oRng.Font.Color = oTbl.Cell(lngIndex, 2).Range.Font.Color


End If
oRng.Collapse wdCollapseEnd

End If
Next oPar
lbl_Exit:
Exit Sub

End Sub


When you have a spare moment in your busy schedule, if you wouldn't mind the inconvenience would you mind seeing why it behaves odd.

thank you again

sand

** becuase it was based on this i didnt want to trouble forum and add new thread - hope that is ok