Vincent88
Active Member
- Joined
- Mar 5, 2021
- Messages
- 382
- Office Version
- 2019
- Platform
- Windows
- Mobile
I want the function to implement only
when the target cell(s) has prefix with REQ000000. My code does not work. Please advise how to retify
VBA Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim LastColumn As Long
Select Case Sh.Name
Case "Agents"
Exit Sub
Case Else
End Select
If Target.Column > 4 Or Target.CountLarge > 1 Then Exit Sub
If Target.Row = 1 Then Exit Sub
LastColumn = Sh.Range("A1").CurrentRegion.Columns.Count
Application.EnableEvents = False
If Cells(Target.Row, "A").Value <> "" And Cells(Target.Row, "B") <> "" Then Exit Sub
If InStr(Cells(Target.Row, "A").Value, "REQ000000") > 0 And Cells(Target.Row, "B") <> "" Then
Cells(Target.Row, "C") = ActiveSheet.Name
Cells(Target.Row, "C").Font.Name = "Times New Roman"
Cells(Target.Row, "C").Font.Size = 12
Cells(Target.Row, "C").HorizontalAlignment = xlRight
Cells(Target.Row, "D").ShrinkToFit = True
Cells(Target.Row, "A").Font.Name = "Times New Roman"
Cells(Target.Row, "A").Font.Size = 12
Cells(Target.Row, "A").HorizontalAlignment = xlLeft
Cells(Target.Row, "B").Font.Name = "Times New Roman"
Cells(Target.Row, "B").Font.Size = 12
Cells(Target.Row, "B").HorizontalAlignment = xlLeft
Else
Cells(Target.Row, "C").ClearContents
Cells(Target.Row, "D").ShrinkToFit = False
End If
Application.EnableEvents = True
End Sub