I have an Excel document to list my music collection and have tried to incorporate a new feature to highlight certain albums in accordance to specific criteria (released before a certain year, in or after a certain year...). The idea was simply to change the font colour of the year(s) for the albums which agreed with said criteria. I have written and borrowed bits of vba code to create a Highlighter Subroutine. I was working with the document on Excel 2019 and tried 4 or 5 different approaches - ALL SEEMED TO highlight the wrong part of the text strings (not exactly the case though - please read on - it's really about text wrapping and cell editing).
Every band for which I have music has one Excel cell which contains a list of all released albums by that group (which is updated by API requests to the MusicBrainz website). Each album is on a separate line within that single cell (additionally with a "|" pipe symbol as a separator before the final vbCrLf carriage return. My aim is to simply change the font colour for the year if it matches - eg. if I indicate "highlight albums released in 2022", then the subroutine should change the font colour of the string "2022" in all the albums cells on the sheet.
As many of the bands have a long list of albums, I like to have a fixed row height for the entire sheet. I do NOT want text wrapping on and uneven row heights. As such, the way to actually view the whole list of albums is to use F2 to open the cell for editing.
SAMPLE TEXT STRING IN ONE CELL for all albums by a specific band (after each pipe symbol there is a carriage return and also after the first closing square bracket): [4 Albums] [01] Elements of Persuasion : 2005-03-29 | [02] Static Impulse : 2010-07-16 | [03] Impermanent Resonance : 2013-07-26 | [04] Beautiful Shade of Grey : 2022-05-20 |
In the sample text above, I wanted to modify the "2022" for the fourth listed album and turn it red.
As indicated, I tried various options, but every time I entered the cell (for editing) Excel seemed to have highlighted the wrong part of the text. I thought it might be because of carriage returns... and tried substituting them for different characters... all to no avail. But finally I realised that Excel WAS highlighting the correct part of the text string BUT only when the cell was unopened for editing.
Finally, I tried again on a different computer (not mine) running Excel 2010 and the code worked absolutely perfectly. I could open the cells for editing and the same part of the string which had been coloured red, remained red. I'm now back at my own computer (Excel 2019) and the code that ran beautifully yesterday, now doesn't again. I have now also realised that if Text Wrapping is on, the highlighting moves also - exactly as if I were using F2.
Sorry for the long-winded explanation/question but... is there some difference between Excel 2010 and 2019 which makes this all happen? Is there a solution? Why should entering a cell to edit the contents (which is my chosen method for visualising these particular cells) make the coloured text move? Is there a way to avoid Excel "moving" the highlighted text when I press F2 to edit (and thereby see) the cell contents? Text wrapping also shifts the highlighted text... Is there any way to avoid this? Apparently this only happens on Excel 2019 - or perhaps it only works correctly on Excel 2010.
Here are 2 images so it's easy to see the difference (marking in red all years >= "2000":
While editing cell contents
Not editing cell contents:
My code for the Highlighter routine is below
Sub Highlighter()
Dim TextRange As Range
Dim HighlighterValues As Range
Dim r As Range
Dim BottomRow As Integer
MUSIC.Select ' MUSIC is the name of the worksheet where the bands and albums are listed
Range("B6").Select
ActiveCell.SpecialCells(xlLastCell).Select
Selection.End(xlUp).Select
BottomRow = ActiveCell.Row
Range("B6").Select
Set TextRange = MUSIC.Range("h6:h" & BottomRow)
TextRange.Font.ColorIndex = xlAutomatic ' ie. set all to black first
Set HighlighterValues = SETTINGS.Range("k2:k63") ' list holding the years to highlight
fontColor = 3 ' red
For Each r In HighlighterValues ' go through all of the values marked to be highlighted
partOfText = r.Text
If partOfText <> "" And partOfText <> 0 Then
For Each part In TextRange
lenOfPart = Len(part)
lenPartOfText = Len(partOfText)
For i = 1 To lenOfPart
TempStr = Mid(part, i, lenPartOfText)
If TempStr = partOfText Then
part.Characters(Start:=i, Length:=lenPartOfText).Font.ColorIndex = fontColor
End If
Next i
Next part
End If
Next r
End Sub
Many thanks for any help!!
CodePudding user response：
Typically the line break in a cell is vbLf (Alt Enter) - if you really have vbCrLf then maybe start by replacing all of those with vbLf instead.
Having said that, I was unable to replicate the problem (my test code below), so maybe it's something specific to your data.
Sub Highlighter()
Dim TextRange As Range
Dim HighlighterValues As Range
Dim r As Range
Dim arrText, arrHV, rwTxt As Long, rwHL As Long, fontcolor As Long, v As String, s As String
MUSIC.Select ' MUSIC is the name of the worksheet where the bands and albums are listed
Set TextRange = MUSIC.Range("h6:h" & MUSIC.Cells(Rows.Count, "B").End(xlUp).Row)
TextRange.Font.ColorIndex = xlAutomatic ' ie. set all to black first
arrText = TextRange.Value 'get as an array
arrHV = SETTINGS.Range("k2:k63").Value
fontcolor = vbRed ' red
Application.ScreenUpdating = False
For rwTxt = 1 To UBound(arrText, 1) 'loop the album lists
v = arrText(rwTxt, 1)
For rwHL = 1 To UBound(arrHV, 1) 'loop the search terms
s = arrHV(rwHL, 1)
If Len(s) > 0 Then
If InStr(1, v, s, vbTextCompare) > 0 Then
HilightAll TextRange.Cells(rwTxt), s, fontcolor
End If
End If
Next rwHL
Next rwTxt
End Sub
'Hilite all instances of `txt` in range `c` with RGB color `clr`
Sub HilightAll(c As Range, txt As String, clr As Long)
Dim pos As Long, i As Long, s
s = c.Value
i = 1
Do
pos = InStr(i, s, txt, vbTextCompare)
If pos = 0 Then Exit Do
c.Characters(pos, Len(txt)).Font.Color = clr
i = pos 1
Loop
End Sub