VBA code change and recognize text

[Excelnewcomer23]

Hi guys, i need some help with word VBA.

I have text in a bullet point form on my word doc and i would like to have certain things be done, when i run a macro. I am fairly new to VBA, therefore struggling with the coding aspect.

Here is the text in m word doc:

• Tsla is up by 23% as compared to April
• FLT is down by -52%, AAPL is up by 4%, BB is up by 183%, SNDL is down by -37% and AMZN is up by 39% as compared to April
• WELL is up by 67% - Doge is down by -73%, KOSS is down by -14% and MSFT is up by 26% as compared to April.

I have jotted down in bullet point form and in the order i hope the code runs in.

1. I would like the macro start where it says any of the stocks tickers, whether it's at the beginning of the line or in the middle. For ex: "Tsla" ,"FLT", "SNDL".
2. I would like the macro to turn any text that indicates "down" to turn red and "up" green only up until the % sign. For ex: " Tsla is up by 23% as compared to April" , "FLT is down by -52%".

I would like the code to run all of the above simultaneously , such as recognizing the ticker symbols, moving between lines/bullet points, turning text red or green depending on the "down" and "up" word.

Thank you so much guys for any assistance you can provide on this matter.

CHEERS!

 

[shknbk2]

Try this:

Sub GreenRed()
    Dim rSearch As Range, rFound As Range
    Dim UpDown(1) As String
    Dim Colors(1) As Integer
    Dim i As Integer
    
    UpDown(0) = "[A-z]@ is up by [0-9]@%"
    UpDown(1) = "[A-z]@ is down by ?@%"
    Colors(0) = wdGreen
    Colors(1) = wdRed
    
    For i = 0 To 1
        Set rSearch = ActiveDocument.Range.Duplicate
        Set rFound = rSearch.Duplicate
        rFound.Find.Execute FindText:=UpDown(i), MatchWildcards:=True
        Do While rFound.Find.Found
            rFound.Font.ColorIndex = Colors(i)
            rSearch.Start = rFound.End
            Set rFound = rSearch.Duplicate
            rFound.Find.Execute FindText:=UpDown(i), MatchWildcards:=True
        Loop
    Next i
End Sub

 

[Excelnewcomer23]

First of all the code works just fine. Thank you for that!

I have another issue where I have certain words that have a dash between them. For ex: “ST - hardship”. While using the same code , how do I make sure the code captures the words before the dash as well.

Thanks again for your assistance!

 

[shknbk2]

Can you clarify? Does “ST - hardship” have anything to do with whether the stock is up or down (and should therefore be red or green)? Provide an example of where it fits in the text and what should be done with it.

 

[Excelnewcomer23]

It doesn’t have anything to do with the stocks directly. It is a part of the text, where I would mention some stocks and if it has increased or decreased. In the same manner, I would also mention if the hardship has decreased or Increased over time . And yes it would have to be red or green, so if the “st- hardship” has increased then it would be green and if it has decreased then it would be red. For ex: Tsla is down by 23% - “ST-Hardship is up by 8% since April”. This would be red and it has gone up then it would be green.

 

[shknbk2]

I added a space and a dash in the brackets as additional characters. The space is included because you had spaces around the dash in your comment #3 above, but in #5, it doesn't have a space. It doesn't matter except that with including the space, more text is selected. For example, using your original text "- Doge is down by -73%" is red and includes the dash; "and MSFT is up by 26%" is green including the "and". If the space isn't there in the actual name like in #5, then removing the spaces from UpDown will not make the dash of Doge and the "and" of MSFT red and green.

Also, you might notice that the original code creates a bunch of undo items. If you wanted to undo all of the coloring, you'd have to click a bunch. I've updated the code so that a single undo item is created that will undo all coloring affected by this procedure in one go. You can change its name if you want.

Sub GreenRed()
    Dim rSearch As Range, rFound As Range
    Dim UpDown(1) As String
    Dim Colors(1) As Integer
    Dim i As Integer
    Dim ur As UndoRecord
    
    Set ur = Application.UndoRecord
    ur.StartCustomRecord "Make green-red"
    
    UpDown(0) = "[A-z -]@ is up by [0-9]@%"
    UpDown(1) = "[A-z -]@ is down by ?@%"
    Colors(0) = wdGreen
    Colors(1) = wdRed
    
    For i = 0 To 1
        Set rSearch = ActiveDocument.Range.Duplicate
        Set rFound = rSearch.Duplicate
        rFound.Find.Execute FindText:=UpDown(i), MatchWildcards:=True
        Do While rFound.Find.Found
            rFound.Font.ColorIndex = Colors(i)
            rSearch.Start = rFound.End
            Set rFound = rSearch.Duplicate
            rFound.Find.Execute FindText:=UpDown(i), MatchWildcards:=True
        Loop
    Next i
    ur.EndCustomRecord
End Sub