Worksheet change based only if cell clicked

[IKHAN]

Hello,

Require assistance with below query to paste information to master sheet(Contact) based on cell clicked and value filled

Help is much appreciated...


Have 3 macros running :

1. First code runs to split fullname from (2. Planning) sheet column D and insert in (4.mobile) sheet (Column D and E)
2. Second code to extract row details from (contacts) sheet based on (4.mobile) sheet (Column D and E)
3. Third code using Worksheet_change to copy/paste information in (contacts) sheet if any info inputted by user in (4.mobile) sheet row.

Issue :

when missing data entered in(4.mobile) sheet row with worksheet_change macro, Information is written in(Contacts)sheet row, However when First macro is run back again , It deletes the information previously copied information and deletes complte row info in mastersheet(contact)

Is there way to tweak code to write information only when cell clicked selected?

First Code :

Private Sub Worksheet_Activate()
    Dim r As Range, a, i As Long, e, x
    Application.EnableEvents = False
    With Sheets("2. Planning")
        If .Range("c" & Rows.Count).End(xlUp).Row > 12 Then
            a = .Range("c12", .Range("c" & Rows.Count).End(xlUp)).Resize(, 2).Value
        End If
    End With
    If IsArray(a) Then
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
            For i = 2 To UBound(a, 1)
                a(i, 1) = Application.Trim(a(i, 1))
                If a(i, 1) <> "" Then
                    For Each e In Split(a(i, 1), ";")
                        x = Split(Application.Trim(e))
                        ReDim Preserve x(1)
                        .Item(Trim$(e)) = x
                    Next
                End If
            Next
            a = Application.Index(.items, 0, 0): i = .Count
        End With
    End If
    With [d18:e18]
        .Resize(Rows.Count - .Row - 1).ClearContents
        If IsArray(a) Then
            .Resize(i).Value = a
        End If
    End With
    Application.EnableEvents = True
    Call Loop_Example
    Call CopyBasedonSheet1
End Sub

Second Code:

Sub CopyBasedonSheet1() 'macro to pullinfo from data into contacts

Dim i As Long
Dim j As Long
Sheet4LastRow = Worksheets("4. Mobile").Range("D" & Rows.Count).End(xlUp).Row
sheet7LastRow = Worksheets("Contacts").Range("A" & Rows.Count).End(xlUp).Row
    For j = 1 To Sheet4LastRow
        For i = 1 To sheet7LastRow
            If Worksheets("4. Mobile").Cells(j, 4).Value = Worksheets("Contacts").Cells(i, 1).Value _
                And Worksheets("4. Mobile").Cells(j, 5).Value = Worksheets("Contacts").Cells(i, 2).Value Then
                Worksheets("4. Mobile").Cells(j, 1).Value = Worksheets("Contacts").Cells(i, 3).Value
                Worksheets("4. Mobile").Cells(j, 3).Value = Worksheets("Contacts").Cells(i, 4).Value
                Worksheets("4. Mobile").Cells(j, 6).Value = Worksheets("Contacts").Cells(i, 5).Value
                Worksheets("4. Mobile").Cells(j, 7).Value = Worksheets("Contacts").Cells(i, 6).Value
                Worksheets("4. Mobile").Cells(j, 8).Value = Worksheets("Contacts").Cells(i, 8).Value

            Else
            End If
    Next i
Next j

End Sub

Third Code :

Private Sub Worksheet_Change(ByVal Target As Range)

Dim i As Long
Dim j As Long

Sheet4LastRow = Worksheets("4. Mobile").Range("D" & Rows.Count).End(xlUp).Row
sheet7LastRow = Worksheets("Contacts").Range("A" & Rows.Count).End(xlUp).Row

    For j = 1 To Sheet4LastRow
        For i = 1 To sheet7LastRow
       
            If Worksheets("contacts").Cells(i, 1).Value = Worksheets("4. mobile").Cells(j, 4).Value _
                And Worksheets("contacts").Cells(i, 2).Value = Worksheets("4. mobile").Cells(j, 5).Value Then
                Worksheets("contacts").Cells(i, 3).Value = Worksheets("4. mobile").Cells(j, 1).Value
                Worksheets("contacts").Cells(i, 4).Value = Worksheets("4. mobile").Cells(j, 3).Value
                Worksheets("contacts").Cells(i, 5).Value = Worksheets("4. mobile").Cells(j, 6).Value
                Worksheets("contacts").Cells(i, 6).Value = Worksheets("4. mobile").Cells(j, 7).Value
                'Worksheets("contacts").Cells(i, 7).Value = Worksheets("4. mobile").Cells(j, 7).Value
                Worksheets("contacts").Cells(i, 8).Value = Worksheets("4. mobile").Cells(j, 8).Value
              Else
          End If
 
    Next i
Next j

End Sub