G
Garbunkel
Hello,
What I am aiming to do is create VBA code that will
interpret data, parsed from a cell that the user inputs
to & change the color of the text if the user has entered
a duplicate entry.
After hacking at this in VBA for a while, I did get it to work
(almost!). The only problem is when there is a duplicate entry, the
text formatting works, but a Type Mismatch error comes up. Here is the
code I wrote:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If IsEmpty(Target) Then Exit Sub
If Not Application.Intersect(Range("A1:A3000"), Target) Is
Nothing
Then
Sheets("A").Activate
Dim i As Integer
Dim RowCount As Integer
Dim CellVaLue
Application.ScreenUpdating = False
Range("J65535").Select
Selection.End(xlUp).Select
Range(Selection, Selection.End(xlUp)).Select
RowCount = Selection.Rows.Count
'define a starting place
Range("J1").Select
Target.Resize(1, 1).Font.ColorIndex = 1
Target.Resize(1, 1).Font.strikethrough = False
'Begining of Loop
'Loop through each of the rows of the spreadsheet
For i = 1 To RowCount
'IF I REMOVE THE '10' FROM THIS LINE, THE ERROR
'GOES AWAY, BUT THEN THE TEXT FORMATTING DOESN'T WORK
CellVaLue = Cells(i + 1, 10).Value
'THIS IS THE LINE THE DEBUGGER HIGHLIGHTS
If (CellVaLue = (Target.Offset(0, 9).Value)) Then
Target.Resize(1, 1).Font.ColorIndex = 7
Target.Resize(1, 1).Font.strikethrough = True
End If
Next
If ((Target.Offset(0, 5).Value = "1") And (Target.Offset(0,
6).Value <> "Yes")) Then
Target.Resize(1, 1).Font.ColorIndex = 3
Target.Resize(1, 1).Font.strikethrough = False
End If
End If
End Sub
Any help is greatly appreciated.
Thanks,
Michael
What I am aiming to do is create VBA code that will
interpret data, parsed from a cell that the user inputs
to & change the color of the text if the user has entered
a duplicate entry.
After hacking at this in VBA for a while, I did get it to work
(almost!). The only problem is when there is a duplicate entry, the
text formatting works, but a Type Mismatch error comes up. Here is the
code I wrote:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If IsEmpty(Target) Then Exit Sub
If Not Application.Intersect(Range("A1:A3000"), Target) Is
Nothing
Then
Sheets("A").Activate
Dim i As Integer
Dim RowCount As Integer
Dim CellVaLue
Application.ScreenUpdating = False
Range("J65535").Select
Selection.End(xlUp).Select
Range(Selection, Selection.End(xlUp)).Select
RowCount = Selection.Rows.Count
'define a starting place
Range("J1").Select
Target.Resize(1, 1).Font.ColorIndex = 1
Target.Resize(1, 1).Font.strikethrough = False
'Begining of Loop
'Loop through each of the rows of the spreadsheet
For i = 1 To RowCount
'IF I REMOVE THE '10' FROM THIS LINE, THE ERROR
'GOES AWAY, BUT THEN THE TEXT FORMATTING DOESN'T WORK
CellVaLue = Cells(i + 1, 10).Value
'THIS IS THE LINE THE DEBUGGER HIGHLIGHTS
If (CellVaLue = (Target.Offset(0, 9).Value)) Then
Target.Resize(1, 1).Font.ColorIndex = 7
Target.Resize(1, 1).Font.strikethrough = True
End If
Next
If ((Target.Offset(0, 5).Value = "1") And (Target.Offset(0,
6).Value <> "Yes")) Then
Target.Resize(1, 1).Font.ColorIndex = 3
Target.Resize(1, 1).Font.strikethrough = False
End If
End If
End Sub
Any help is greatly appreciated.
Thanks,
Michael