I have data in a Google sheet and would like to select all - copy - paste into Excel.
For some of the rows, there is text within square brackets I need to be Red.
Example: ‘Insert text here [Highlighted Text]’
I am using this macro:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Text As String
Dim Index1 As Long
Dim Index2 As Long
Text = Target.Text
Index2 = 1
Do
Index1 = InStr(Index2, Text, "[")
If Index1 = 0 Then Exit Do
Index2 = InStr(Index1, Text, "]")
If Index2 = 0 Then Exit Do
Target.Characters(Index1, Index2 - Index1 + 1).Font.Color = &HFF
Loop
End Sub
It works if I move data one row by one row.
However, it’s a few thousand rows so I need to select all, copy all, and paste all.
When I do this, an error message will pop up.
I have data in a Google sheet and would like to select all - copy - paste into Excel.
For some of the rows, there is text within square brackets I need to be Red.
Example: ‘Insert text here [Highlighted Text]’
I am using this macro:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Text As String
Dim Index1 As Long
Dim Index2 As Long
Text = Target.Text
Index2 = 1
Do
Index1 = InStr(Index2, Text, "[")
If Index1 = 0 Then Exit Do
Index2 = InStr(Index1, Text, "]")
If Index2 = 0 Then Exit Do
Target.Characters(Index1, Index2 - Index1 + 1).Font.Color = &HFF
Loop
End Sub
It works if I move data one row by one row.
However, it’s a few thousand rows so I need to select all, copy all, and paste all.
When I do this, an error message will pop up.
3 Answers
Reset to default 2When you paste a range, then the Target
will be also a range not a single cell.
Therefore need to iterate through the range.
The below mod of your code will do that.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Text As String
Dim Index1 As Long
Dim Index2 As Long
For Each cel In Target
Text = cel.Text
Index2 = 1
Index1 = InStr(Index2, Text, "[")
If Index1 <> 0 Then
Index2 = InStr(Index1, Text, "]")
If Index2 <> 0 Then
cel.Characters(Index1, Index2 - Index1 + 1).Font.Color = &HFF
End If
End If
Next cel
End Sub
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim regex As Object, m As Object, cel as Range, r As Long
Dim t0 As Single: t0 = Timer
' build regex pattern
Set regex = CreateObject("vbscript.regexp")
With regex
.Global = True
.MultiLine = True
.IgnoreCase = True
.Pattern = "\[([^]]+)\]" ' [(any text not ])]
End With
' color text inside []
For Each cel In Target.Cells
For Each m In regex.Execute(cel)
cel.Characters(m.firstindex + 2, Len(m) - 2).Font.Color = vbRed '&HFF
'r = r + 1
Next
Next
'MsgBox Target.Cells.Count & " cells scanned" & vbLf & r & " changes in " & _
' Format(Timer - t0, "0.0 secs"), vbInformation, Target.Address
End Sub
An alternative using Regular Expressions
which works only in Column A
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myStr As String, regExp As Object, j As Integer
Dim objMatches As Object, xRng As Range, xMatch As Object
If Not Intersect(Range("A:A"), Target) Is Nothing Then
Set regExp = CreateObject("VBscript.RegExp")
regExp.Pattern = "\[(.*?)\]"
regExp.Global = True
For Each xRng In Selection
j = 0
Set objMatches = regExp.Execute(xRng.Text)
For Each xMatch In objMatches
xRng.Characters(xMatch.FirstIndex + j, xMatch.Length + 1).Font.Color = vbRed
Next
Next
End If
Set objMatches = Nothing
Set regExp = Nothing
End Sub