Using the code below to search a range in Excel and color code the matching string. How can this be altered so that the string that is searched is matched regardless of case? So, "yes" and "Yes" and "YES" would all hit successfully and be color coded accordingly for example? This macro does a great job to highlight the text desired in red for example, but you have to run it multiple times for each iteration of the text in lower and upper case. How can this be done to highlight the text regardless of the case?
Any direction on the correct command or switch to use to ignore case when matching text would be very appreciated.
Public Sub ChangeTextColor()
Application.ScreenUpdating = False
Dim Rng As Range
Dim cFnd As String
Dim xTmp As String
Dim x As Long
Dim m As Long
Dim y As Long
cFnd = InputBox("Enter the text string to highlight")
y = Len(cFnd)
For Each Rng In Selection
With Rng
m = UBound(Split(Rng.Value, cFnd))
If m > 0 Then
xTmp = ""
For x = 0 To m - 1
xTmp = xTmp & Split(Rng.Value, cFnd)(x)
.Characters(Start:=Len(xTmp) + 1, Length:=y).Font.ColorIndex = 3
xTmp = xTmp & cFnd
Next
End If
End With
Next Rng
Application.ScreenUpdating = True
End Sub
Unsure where to add a line regarding case sensitivity. Is there a command or variable that would tell this routine / macro to ignore case and match both upper and lower case characters?
Dear experts in Excel and VBA!
Could you tell me how you can color a certain line (condition - the presence of a certain word) in a Comments?
Comment consists of several lines, separated by Chr (10).
Example in picture1:
the comment has 4 lines, the second line contains the word "VBA", so this line should be highlighted in red.
The main problem is that the test word "VBA" can be in any line, there can be from 1 to 10+ lines.
I assumed that:
can move data from comment to cell
replace Chr (10) with some character, for example, "_"
distribute the text of the cell into columns through the "column distribution wizard"
search for the desired word "VBA" in the received cells
determine the cell number and understand that this is the number of the required line in the comment
based on the cell number, paint over the line number in the comment
Can you please tell me if my action logic is correct? Am I heading in the right direction?
If so, what is the correct way to carry out points 4-6?
enter image description here
would this help?
"test" is the codename for the sheet I have set, change it according to your situation.
"i" will give you the line number, starting from 0. So in your example it would be 1.
Edit: Added Exit For in the if check.
Option Explicit
Sub test_note()
Dim strNote As String
Dim arrNote As Variant
Dim number_of_lines As Integer
strNote = test.Range("A5").NoteText
number_of_lines = Len(strNote) - Len(Replace(strNote, Chr(10), "")) + 1
ReDim arrNote(1 To number_of_lines) As String
arrNote = Split(strNote, Chr(10))
Dim i As Long
For i = LBound(arrNote) To UBound(arrNote)
If InStr(arrNote(i), "VBA") > 0 Then
Debug.Print i, arrNote(i)
Exit For 'If you are sure there won't be any other occurrence of VBA in there, why check the rest of the lines? Speeds code depending on circumstance.
End If
Next i
End Sub
Edit 2: Revised code to change the color of the comment line.
Sub test_note()
Dim strNote As String
Dim arrNote As Variant
Dim number_of_lines As Integer
strNote = test.Range("B5").NoteText
number_of_lines = Len(strNote) - Len(Replace(strNote, Chr(10), "")) + 1
ReDim arrNote(1 To number_of_lines) As String
arrNote = Split(strNote, Chr(10))
Dim i As Long
Dim startPos As Integer
Dim number_of_chars As Integer
startPos = 1
' Reset comment font color
test.Range("B5").Comment.Shape.TextFrame.Characters.Font.Color = 0
For i = LBound(arrNote) To UBound(arrNote)
If InStr(arrNote(i), "VBA") > 0 Then
number_of_chars = Len(arrNote(i))
test.Range("B5").Comment.Shape.TextFrame.Characters(startPos, number_of_chars).Font.Color = vbRed
Debug.Print i, arrNote(i), "startPos: " & startPos, "numChars: " & number_of_chars
Else
startPos = startPos + Len(arrNote(i)) + 1
End If
Next i
End Sub
Check this. Just running this VBA copies your comments to the cells
and highlights the lines containing "VBA", however, it does this for
all comments on all sheets
credit: https://martinbosanacvba.blogspot.com/2021/08/copying-comments-to-cells-and.html
Sub Demo()
Dim tnahqb1 As Range
Dim tnahqb2 As Range
Dim tnahqb3 As Workbook
Dim tnahqb4 As Worksheet
Dim tnahqb5 As Variant
Dim tnahqb6 As Integer
Dim tnahqb7 As Integer
Dim tnahqb8 As Integer
Dim tnahqb9 As Integer
For Each tnahqb10 In ActiveWorkbook.Worksheets
Set tnahqb1 = tnahqb10.Cells.SpecialCells(xlCellTypeComments)
If tnahqb1 Is Nothing Then
MsgBox "No comments in the sheet"
Else
For Each cell In tnahqb1
cell.Value = cell.Comment.Text
tnahqb5 = Split(cell.Comment.Text, Chr(10))
tnahqb6 = UBound(tnahqb5) - LBound(tnahqb5) + 1
For I = LBound(tnahqb5) To UBound(tnahqb5)
If InStr(tnahqb5(I), "VBA") > 0 Then
tnahqb8 = Len(tnahqb5(I))
With cell
tnahqb7 = InStr(cell.Comment.Text, tnahqb5(I))
tnahqb9 = tnahqb7 + tnahqb8
.Characters(tnahqb7, tnahqb8).Font.Color = vbRed
End With
End If
Next I
Next cell
End If
Next tnahqb10
End Sub
My vba code should organiza a balance sheet I just pasted o Excel from a PDF. So, like most balance sheets, there are the description of the item (asset/liabilities/etc) and the values from the years that are being analyzed.
First, I was trying to identify in which position the text ended. So I wrote the following code, which is giving me and error (Invalid Qualifier).
Dim subjectCell As String
Dim letters As String
Dim index As Integer
letters = "qwertyuiopasdfghjklçzxcvbnmQWERTYUIOPASDFGHJKLÇZXCVBNM "
subjectCell = ActiveCell.Value
For i = 0 To Len(subjectCell) - 1
If (letters.Contains(Mid(subjectCell, i + 1, 1))) Then
Else
index = i
Next i
Cell("A1").Value = index
Sub test()
Dim subjectCell As String
Dim letters As String
Dim index As Integer
letters = "qwertyuiopasdfghjklçzxcvbnmQWERTYUIOPASDFGHJKLÇZXCVBNM "
subjectCell = ActiveCell.Value2
For i = 1 To Len(subjectCell)
If InStr(1, letters, Mid(subjectCell, i, 1), vbTextCompare) = 0 Then
index = i
Exit For
End If
Next i
Range("A1").Value2 = index
End Sub
There are a few problems here
No end if for your if statement
Your cell should be range if you're defining a range like A1, cells is for 1, 1 type reference
Using ActiveCell is poor form, define it explicitly
Using Range("A1").Value is better but also poor form, fully define it like workbooks("book1.xlsx").sheets("Sheet1").Range("A1").Value
You cant use the letters.function( type in vba, I've illustrated instr (or in string) to show how this can work to a similar effect.
I've changed your code to better illustrate what it maybe should look like:
Sub g()
Dim subjectCell As String
Dim letters As String
Dim index As Integer
letters = "qwertyuiopasdfghjklçzxcvbnmQWERTYUIOPASDFGHJKLÇZXCVBNM "
'subjectCell = ActiveCell.Value
subjectCell = "a"
For i = 0 To Len(subjectCell) - 1
If InStr(letters, subjectCell) > 0 Then
Debug.Print "Found it! It starts at position: " & InStr(letters, subjectCell)
Else
Debug.Print "No Match"
index = i
End If
Next i
Range("A1").Value = index
End Sub
I have created thermometer charts which are colored based on a range (red - poor, yellow - average, green - good) from cells in my sheet. That is, the chart references the color of the cell to determine fill color. However, when printed in black and white the red and green are difficult to distinguish. I do not want to abandon the stoplight coloring because it is intuitive for my audience.
I am trying to figure out how to get the chart fill to reflect the pattern in the cells in addition to the color. My current syntax (for color fill) is below.
Sub ColorByValueSMICAUpdate()
Dim rPatterns As Range
Dim iPattern As Long
Dim vPatterns As Variant
Dim iPoint As Long
Dim vValues As Variant
Dim rValue As Range
Set rPatterns = ActiveSheet.Range("P5:P11")
vPatterns = rPatterns.Value
With ActiveChart.SeriesCollection(1)
vValues = .Values
For iPoint = 1 To UBound(vValues)
For iPattern = 1 To UBound(vPatterns)
If vValues(iPoint) <= vPatterns(iPattern, 1) Then
.Points(iPoint).Format.Fill.ForeColor.RGB = _
rPatterns.Cells(iPattern, 1).Interior.Color
Exit For
End If
Next
Next
End With
End Sub
Thank you!
The key to this problem is that the fill on the cell is an interior.pattern object and the fill on the chart is a format.fill.patterned object. The only way is to convert a pattern into a patterned as stated above by David Zemens.
The code below will works but you may want to play around with which pattern converts to which patterned.
TRIED AND TESTED
Sub ColorByValueSMICAUpdate()
Dim rPatterns As Range
Dim iPattern As Long
Dim vPatterns As Variant
Dim iPoint As Long
Dim vValues As Variant
Dim rValue As Range
Set rPatterns = ActiveSheet.Range("P5:P11")
vPatterns = rPatterns.Value
With ActiveChart.SeriesCollection(1)
vValues = .Values
For iPoint = 1 To UBound(vValues)
For iPattern = 1 To UBound(vPatterns)
If vValues(iPoint) <= vPatterns(iPattern, 1) Then
.Points(iPoint).Format.Fill.ForeColor.RGB = _
rPatterns.Cells(iPattern, 1).Interior.Color
.Points(iPoint).Format.Fill.Patterned _
ConvertPatternToPattened(rPatterns.Cells(iPattern, 1).Interior.pattern)
Exit For
End If
Next
Next
End With
End Sub
Private Function ConvertPatternToPattened(pattern As Integer) As Integer
' To change the converted patterns please refer to the two references below
'
' Patterned List - http://msdn.microsoft.com/en-us/library/office/aa195819(v=office.11).aspx
' Pattern List - http://msdn.microsoft.com/en-us/library/microsoft.office.interop.excel.interior.pattern(v=office.15).aspx
Dim Result As Integer
Result = msoPattern90Percent
Select Case pattern
Case xlPatternChecker
Result = msoPatternLargeCheckerBoard
Case xlPatternCrissCross
Result = msoPattern90Percent
Case xlPatternDown
Result = msoPatternNarrowVertical
Case xlPatternGray16
Result = msoPattern20Percent
Case xlPatternGray25
Result = msoPattern25Percent
Case xlPatternGray50
Result = msoPattern50Percent
Case xlPatternGray75
Result = msoPattern75Percent
Case xlPatternGray8
Result = msoPattern10Percent
Case xlPatternGrid
Result = msoPatternSmallGrid
Case xlPatternHorizontal
Result = msoPatternLightHorizontal
Case xlPatternLightDown
Result = msoPatternLightVertical
Case xlPatternLightHorizontal
Result = msoPatternNarrowHorizontal
Case xlPatternLightUp
Result = msoPatternLightVertical
Case xlPatternLightVertical
Result = msoPattern90Percent
Case xlPatternSemiGray75
Result = msoPattern80Percent
Case xlPatternSolid
Result = msoPattern90Percent
Case xlPatternUp
Result = msoPatternDarkVertical
Case xlPatternVertical
Result = msoPatternDashedVertical
Case Else
Result = msoPattern90Percent
End Select
ConvertPatternToPattened = Result
End Function
I would like to write a VBA function to highlight specific text within an excel cell. Is this possible? I've been googling but it's unclear at this point.
to clarify, I would like to search a specific column for a text value (actually a list of values) and highlight the matched text in say yellow.
Note: this is what I ended up doing:
Sub Colors()
Dim searchString As String
Dim targetString As String
Dim startPos As Integer
searchString = "abc"
targetString = Cells(2, 1).Value
startPos = InStr(targetString, searchString)
If startPos > 0 Then
Cells(2, 1).Characters(startPos, Len(searchString)).Font.Color = vbRed
End If
End Sub
This is the basic principle, I assume that customizing this code is not what you are asking (as no details about this were provided):
Sub Colors()
With Range("A1")
.Value = "Test"
.Characters(2, 2).Font.Color = vbGreen
End With
End Sub
Small description although it speaks quite for itself: the first "2" refers to the first character that needs to be colored, the second "2" refers to the length.
This is only for future readers trying to highlight a specific string pattern inside of cells,
(which is how I had interpreted the question)
You can set the string being searched for in F1 in this example
Sub test4String2color()
Dim strTest As String
Dim strLen As Integer
strTest = Range("F1")
strLen = Len(strTest)
For Each cell In Range("A1:D100")
If InStr(cell, strTest) > 0 Then
cell.Characters(InStr(cell, strTest), strLen).Font.Color = vbRed
End If
Next
End Sub
This is answer is specifically for #t.ztrk who has cities in Col1 and text to search for those cities in column 2. He posted his question over here:
is it possible to find and change color of the text in excel
I borrowed from this code from another solution (sorry if it was not the original):https://stackoverflow.com/a/11676031/8716187
Sub test4String2color()
Dim strTest As String
Dim strLen As Integer
strTest = Range("F1")
strLen = Len(strTest)
For Each cell In Range("A1:D100")
If InStr(cell, strTest) > 0 Then
cell.Characters(InStr(cell, strTest), strLen).Font.Color = vbRed
End If
Next
End Sub
I know this might not be elegant but I punched it out in a few minutes to meet the users need. Sorry in advance if the solutions provided above are (1) more flexible or (2) more efficient. Also sorry for my C++ nested loop habits coming through.
#t.ztrk you can record a macro and just stop it (delete whatever is there) or insert a button control and paste the code there. Not sure what your VB familiarity is. Just be sure to select a cell on the worksheet you want to process before you run the macro (it should run on any sheet and can be made to work on any workbook).
Sub Macro1()
'Searches all text in Column 2 on a Sheet for the string located in Column 1
'If found it highlights that text
Dim ThisWB As Workbook
Dim ThisWS As Worksheet
Dim i As Integer
Dim y As Integer
Dim Col1 As Double
Dim Col2 As Double
Dim Col1_rowSTART As Double
Dim Col1_rowEND As Double
Dim Col2_rowSTART As Double
Dim Col2_rowEND As Double
Dim strTest As String
Dim strLen As Integer
'Set up parameter that we know
Set ThisWB = ActiveWorkbook
Set ThisWS = ActiveSheet
Col1 = 1 'city column
Col2 = 2 'text search column
'Define Starting Row for each column
Col1_rowSTART = 1
Col2_rowSTART = 1
'Define ending row for each column
Col1_rowEND = ThisWS.Cells(ThisWS.Rows.Count, Col1).End(xlUp).Row
Col2_rowEND = ThisWS.Cells(ThisWS.Rows.Count, Col2).End(xlUp).Row
'Could be fancy and see which column is shorter ....
'Won't do that here
For i = Col1_rowSTART To Col1_rowEND
'make a string out of each cell value in Col1
strTest = CStr(ThisWS.Cells(i, Col1))
strLen = Len(strTest)
'Roll thorugh all of Column 2 in search of the target string
For y = Col2_rowSTART To Col2_rowEND
'Check if Col1 string is in Col2 String
If InStr(CStr(ThisWS.Cells(y, Col2)), strTest) > 0 Then
ThisWS.Cells(y, Col2).Characters(InStr(ThisWS.Cells(y, Col2), strTest), strLen).Font.Color = vbRed
End If
Next y
Next i
MsgBox ("City Search Complete!")
End Sub
Here is your testing screenshot.
Cheers - Keep learning and applying.
-WWC
One problem with highlighting text in a cell is that there could be more than one occurrence of the string, so the code should really check to see if there are any more. Here's my solution to that problem:
Sub Colors()
Dim searchTerms As Variant
searchTerms = Array("searchterm1", "searchterm2", "lastsearchterm")
Dim searchString As String
Dim targetString As String
Dim offSet As Integer
Dim colToSearch As Integer
Dim arrayPos, rowNum As Integer
colToSearch = 3
For arrayPos = LBound(searchTerms) To UBound(searchTerms)
For rowNum = 2 To 31124
searchString = Trim(searchTerms(arrayPos))
offSet = 1
Dim x As Integer
targetString = Cells(rowNum, colToSearch).Value
x = HilightString(offSet, searchString, rowNum, colToSearc)
Next rowNum
Next arrayPos
End Sub
Function HilightString(offSet As Integer, searchString As String, rowNum As Integer, ingredCol As Integer) As Integer
Dim x As Integer
Dim newOffset As Integer
Dim targetString As String
' offet starts at 1
targetString = Mid(Cells(rowNum, ingredCol), offSet)
foundPos = InStr(LCase(targetString), searchString)
If foundPos > 0 Then
' the found position will cause a highlight where it was found in the cell starting at the offset - 1
Cells(rowNum, ingredCol).Characters(offSet + foundPos - 1, Len(searchString)).Font.Color = vbRed
' increment the offset to found position + 1 + the length of the search string
newOffset = offSet + foundPos + Len(searchString)
x = HilightString(newOffset, searchString, rowNum, ingredCol)
Else
' if it's not found, come back out of the recursive call stack
Exit Function
End If
End Function
#Jack BeNimble
thanks for the code, used it successfully in 10 mins to highlight all the numbers in a cell. I reorganized it a tad, searching all search terms within a row and cell first and allowed for multiple columns. I found one error, your highlight text didn't like repeats 55, 444, only highlighted the odd repeats in a sequence. Modified one line in Highlight Function
newOffset = offSet + foundPos + Len(searchString) - 1 //added the - 1.
here is my modified code.
Sub NumberColors()
Dim searchTerms As Variant
searchTerms = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", ".")
Dim searchString As String
Dim targetString As String
Dim offSet As Integer
Dim colsToSearch As Variant
Dim arrayPos, colIndex, colNum As Integer
Dim rowNum As Integer
colsToSearch = Array(4, 44, 45)
For colIndex = LBound(colsToSearch) To UBound(colsToSearch)
colNum = colsToSearch(colIndex)
For rowNum = 5 To 3000
For arrayPos = LBound(searchTerms) To UBound(searchTerms)
searchString = Trim(searchTerms(arrayPos))
offSet = 1
Dim x As Integer
targetString = Cells(rowNum, colNum).Value
x = HilightString(offSet, searchString, rowNum, colNum)
Next arrayPos
Next rowNum
Next colIndex
End Sub
Function HilightString(offSet As Integer, searchString As String, rowNum As Integer, ingredCol As Integer) As Integer
Dim x As Integer
Dim newOffset As Integer
Dim targetString As String
' offet starts at 1
targetString = Mid(Cells(rowNum, ingredCol), offSet)
foundPos = InStr(LCase(targetString), searchString)
If foundPos > 0 Then
' the found position will cause a highlight where it was found in the cell starting at the offset - 1
Cells(rowNum, ingredCol).Characters(offSet + foundPos - 1, Len(searchString)).Font.Color = vbBlue
' increment the offset to found position + 1 + the length of the search string
newOffset = offSet + foundPos + Len(searchString) - 1
x = HilightString(newOffset, searchString, rowNum, ingredCol)
Else
' if it's not found, come back out of the recursive call stack
Exit Function
End If
End Function
Thanks Jack BeNimbleand datatoo
You don't need VBA to do this. You can use Conditional Formatting.
Let's say you have a set of values in column E. You want to enter a value in cell B1 and highlight the cells in column E that match that value.
Highlight the cells in column E and apply the following conditional formatting:
Change the color(s) to suit. This will apply relative conditional formatting to the cells in column E. Ex: select E3 and view the conditional formatting, it should look like this:
You can see how the formula adjusted itself.
(Edit: If you want to match the value in B1 to a substring of a value in column E, use this conditional formatting formula instead: =FIND($B$1,E1)>0)
Now type different values in cell B1. If you type a value that matches one of the values in column E, those cells (in column E) will change color. Change cell B1 to a value that does not exist in column E, the formatting disappears.