Macro that automatically formats cell when value is entered. (convert macro to the event macro?)

StackOverflow https://stackoverflow.com/questions/19121209

  •  30-06-2022
  •  | 
  •  

質問

I've got a spreadsheet, where I'd like A:A range to be formatted automatically so that characters will show in red and digits stay the same color. The following macro seems to work OK, but I need to manually run it every time I change value in the cell:

Sub Red_text()

Dim i As Integer
Dim MyString As String

MyString = ActiveCell.Value

For i = 1 To Len(MyString)
    If IsNumeric(Mid(MyString, i, 1)) = False Then
        ActiveCell.Characters(i, 1).Font.Color = RGB(247, 66, 66)
    End If
Next i

End Sub

So basically I need to change it into an event macro that will reformat the current cell every time it is edited. And limit this behavior to A:A range.

Any help would be greatly appreciated!!

役に立ちましたか?

解決

First a slight change to your macro:

Sub Red_text(r As Range)

Dim i As Integer
Dim MyString As String

MyString = r.Value

For i = 1 To Len(MyString)
    If IsNumeric(Mid(MyString, i, 1)) = False Then
        r.Characters(i, 1).Font.Color = RGB(247, 66, 66)
    End If
Next i
End Sub

and also include the following event macro in the worksheet code area:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim A As Range
    Set A = Range("A:A")
    If Intersect(A, Target) Is Nothing Then Exit Sub
    Application.EnableEvents = False
        Call Red_text(Target)
    Application.EnableEvents = True
End Sub

The event macro detects entries to column A and then applies formatting.

EDIT#1:

The event macro must change to handle more than one cell at a time. Remove the original event macro and use this:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim A As Range, rBIG As Range, r As Range
    Set A = Range("A:A")
    Set rBIG = Intersect(A, Target)
    If rBIG Is Nothing Then Exit Sub
    Application.EnableEvents = False
        For Each r In rBIG
            Call Red_text(r)
        Next r
    Application.EnableEvents = True
End Sub
ライセンス: CC-BY-SA帰属
所属していません StackOverflow
scroll top