Jagat Pavasia
Active Member
- Joined
- Mar 9, 2015
- Messages
- 359
- Office Version
- 2021
- Platform
- Windows
I HAVE VBA CODE BELOW, IT IS WORKING AS IT SHOULD.
BUT NOW I WANT THE CELL HIGHLIGHT WHEN I SELECT IT.
FOR EXAMPLE : IF I SELECT "B8" THEN ALL LINE FROM "A8 TO N8" SHOULD BE HIGH-LIGHTED.
IF I SELECT "C9" THEN ALL LINE FROM "A9 TO N9" SHOULD BE HIGHLIGHTED..
I HAVE TRIED CONDITIONAL FORMULA "
=OR(CELL("row")=ROW())
BUT IT IS NOT WORK FOR ME. PLEASE HELP ME,
TELL ME IF LITTLE CHANGE IN VBA CODE (if)
VBA CODE :
Private Sub worksheet_change(ByVal target As Range)
Macro1 target
Macro2 target
End Sub
Sub Macro1(target As Range)
Dim Rng As Range
If target.Count > 1 Then Exit Sub
Application.EnableEvents = False
ActiveSheet.Unprotect
Set Rng = Range("b:b,j:j,M:M")
If Not Intersect(target, Rng) Is Nothing Then
If target.Value = "**" Then target.Value = Format(Now, "m/d/yy, h:mm AM/PM")
End If
If Not Intersect(target, Range("B4:R4")) Is Nothing Then
If target.Value = "" Then
ActiveSheet.Range("B6:R6").AutoFilter Field:=target.Column
Else
ActiveSheet.Range("B6:R6").AutoFilter Field:=target.Column, Operator:=xlFilterValues, Criteria1:=CStr(target.Value)
End If
End If
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True, AllowFiltering:=True
Application.EnableEvents = True
End Sub
Sub Macro2(target As Range)
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("F6:F9999,H6:H9999,K6:K9999"), target)
xOffsetColumn = 1
If Not WorkRng Is Nothing Then
Application.EnableEvents = False
On Error GoTo exit_proc
Me.Unprotect
For Each Rng In WorkRng
If Not VBA.IsEmpty(Rng.Value) Then
Rng.Offset(0, xOffsetColumn).Value = Now
Rng.Offset(0, xOffsetColumn).NumberFormat = "d/m/yy, h:mm AM/PM"
Else
Rng.Offset(0, xOffsetColumn).ClearContents
End If
Next
Application.EnableEvents = True
End If
exit_proc:
Me.Protect
End Sub
BUT NOW I WANT THE CELL HIGHLIGHT WHEN I SELECT IT.
FOR EXAMPLE : IF I SELECT "B8" THEN ALL LINE FROM "A8 TO N8" SHOULD BE HIGH-LIGHTED.
IF I SELECT "C9" THEN ALL LINE FROM "A9 TO N9" SHOULD BE HIGHLIGHTED..
I HAVE TRIED CONDITIONAL FORMULA "
=OR(CELL("row")=ROW())
BUT IT IS NOT WORK FOR ME. PLEASE HELP ME,
TELL ME IF LITTLE CHANGE IN VBA CODE (if)
VBA CODE :
Private Sub worksheet_change(ByVal target As Range)
Macro1 target
Macro2 target
End Sub
Sub Macro1(target As Range)
Dim Rng As Range
If target.Count > 1 Then Exit Sub
Application.EnableEvents = False
ActiveSheet.Unprotect
Set Rng = Range("b:b,j:j,M:M")
If Not Intersect(target, Rng) Is Nothing Then
If target.Value = "**" Then target.Value = Format(Now, "m/d/yy, h:mm AM/PM")
End If
If Not Intersect(target, Range("B4:R4")) Is Nothing Then
If target.Value = "" Then
ActiveSheet.Range("B6:R6").AutoFilter Field:=target.Column
Else
ActiveSheet.Range("B6:R6").AutoFilter Field:=target.Column, Operator:=xlFilterValues, Criteria1:=CStr(target.Value)
End If
End If
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True, AllowFiltering:=True
Application.EnableEvents = True
End Sub
Sub Macro2(target As Range)
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("F6:F9999,H6:H9999,K6:K9999"), target)
xOffsetColumn = 1
If Not WorkRng Is Nothing Then
Application.EnableEvents = False
On Error GoTo exit_proc
Me.Unprotect
For Each Rng In WorkRng
If Not VBA.IsEmpty(Rng.Value) Then
Rng.Offset(0, xOffsetColumn).Value = Now
Rng.Offset(0, xOffsetColumn).NumberFormat = "d/m/yy, h:mm AM/PM"
Else
Rng.Offset(0, xOffsetColumn).ClearContents
End If
Next
Application.EnableEvents = True
End If
exit_proc:
Me.Protect
End Sub