Academic Integrity: tutoring, explanations, and feedback — we don’t complete graded work or submit on a student’s behalf.

I am trying to combine this to macro together, by at the end of each macro I haa

ID: 3562804 • Letter: I

Question

I am trying to combine this to macro together, by at the end of each macro I haave inserted End if. I usually do the same for all when I am using more than 1 private change sheet event, but witth thesse two macros I am trying to combine End if at the end of the macro its not working. The end if in the boldd part of the private sheet change event.

Thanks

Owen

Macro are provided here:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, Rng2 As Range
Dim rCell As Range
Dim srcRng As Range, destRng As Range
Dim LRow As Long

LRow = Me.Range("E4").End(xlDown).Row
Set Rng = Me.Range("E4:E4")
Set Rng2 = Intersect(Rng, Target)

If Not Rng2 Is Nothing Then
For Each rCell In Rng2.Cells
On Error GoTo XIT
Application.EnableEvents = False
With rCell
Set srcRng = .Offset(0, 1)
Set destRng = .Offset(0, 2)
srcRng.Copy destRng
End With
Next rCell
End If
XIT:
Application.EnableEvents = True
  
End If

Dim rngC As Range
If Not Intersect(Target, Range("E4:E4")) Is Nothing Then
Application.EnableEvents = False
For Each rngC In Intersect(Target, Range("E4:E4"))
If rngC.Value = "" Then
Intersect(Target.EntireRow, Range("G:G")).Clear

Next rngC
Application.EnableEvents = True
End If
End Sub

Explanation / Answer

If I have correctly understood your intention, try something like:

'=========>>
Option Explicit

'--------->>
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, Rng2 As Range
Dim rCell As Range
Dim srcRng As Range, destRng As Range
Dim LRow As Long
Const firstRow As Long = 4

With Me
LRow = .Cells(Rows.Count, "E").End(xlUp).Row
If LRow >= firstRow Then
Set Rng = .Range("E" & firstRow & ":E" & LRow)
Set Rng2 = Intersect(Rng, Target)
End If
End With

If Not Rng2 Is Nothing Then
For Each rCell In Rng2.Cells
On Error GoTo XIT
Application.EnableEvents = False
With rCell
Set srcRng = .Offset(0, 1)
Set destRng = .Offset(0, 2)
If .Value = vbNullString Then
destRng.ClearContents
Else
srcRng.Copy destRng
End If
End With
Next rCell
End If
XIT:
Application.EnableEvents = True
End Sub
'<<=========

===

Regards,

Hire Me For All Your Tutoring Needs
Integrity-first tutoring: clear explanations, guidance, and feedback.
Drop an Email at
drjack9650@gmail.com
Chat Now And Get Quote