Copy active cell value to cell on listed row numbers

[AllyGraham]

Hi, I am in need of some help, and I hope to explain it to the best of my ability.

What I have achieved in sheet 'Duplicates list' is a list of duplicate email addresses and the contact details for that, from multiple records, and the row number that entry occupies in 'Master List'. I can trigger VBA and macros upon selection change event, not an issue, but what I am trying to achieve is that when (in below simple example) cell C3 is selected, it will copy the cell value to (in this case) C10, C20, C50, and C65 in 'Master List'.

	A	B	C	D	E
1	Row	Email Address	First Name	Last Name	Company Name
2	10	info@sampletext.co.uk		A. Non
3	20	info@sampletext.co.uk	Anon
4	50	info@sampletext.co.uk		blank	Sample Text Ltd.
5	65	info@sampletext.co.uk	Anon
6
7	15	office@company.com	John	Smith
8	19	office@company.com	John	Simpson	Company PLC

I will allow the same process for selecting a cell from column D, E, etc. to their respective cells.
I intend to have a confirmation message box (yes/no) to confirm the action upon the selection change event being triggered, again this is not an issue for me, I am just a bit stuck on how to drive the copy and paste to the rows listed in reference to the same email address, when the count of such records may vary from 2 to 20.

This has all come about as we are bringing together many separate contact lists and are needing to de-duplicate and check valid details for them, which once we have merged the entries together based on deciding what is the correct details to use, we can delete the new full duplicates. After this, the list will be imported into our system.

I hope this makes sense, and someone can help me.

 

[JGordon11]

Try this on a copy of your workbook

Put this code in the Duplicates sheet module:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
    With Target
        Dim tv, tc As Long
        tv = .Value
        tc = .Column
    End With
       
    If tc < 3 Or tc > 5 Or Len(tv) = 0 Then Exit Sub
   
    Dim gl
    gl = GetList()
   
    With Sheets("Master Sheet")
        Dim rw
        For Each rw In gl
            .Cells(rw, tc) = tv
        Next
    End With

End Sub

And this code in a standard module:

Function GetList()
    Dim i As Long, j As Long, ct As Long, strt As Long, finish As Long
    i = ActiveCell.Row
    j = i
    ct = 0
    Do While Cells(i, 2) = Cells(j, 2) And Len(Cells(j, 2)) > 0
        j = j - 1
        ct = ct + 1
    Loop
    strt = i - ct + 1
    j = i + 1
    Do While Cells(i, 2) = Cells(j, 2) And Len(Cells(j, 2)) > 0
        j = j + 1
        ct = ct + 1
    Loop
    finish = strt + ct - 1
    GetList = Range(Cells(strt, 1), Cells(finish, 1))
End Function

 

[AllyGraham]

Thank you for that, however I get a type mismatch for

For Each rw In gl

 

[JGordon11]

What do you have in the Dim statement above that line? It should be just Dim rw not Dim rw as Long

When I first posted I had the as Long in there and subsequently edited it out.

 

[AllyGraham]

It is Dim rw. Had tried Dim rw as Long too in case this was the error.

 

[JGordon11]

OK. If there is only one of a particular email in Duplicates it gives an error because GetList is returning a single value and not an array.

I'll modify it to handle that case.

 

[JGordon11]

try

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
    With Target
        Dim tv, tc As Long
        tv = .Value
        tc = .Column
    End With
        
    If tc < 3 Or tc > 5 Or Len(tv) = 0 Then Exit Sub
    
    Dim gl
    gl = GetList()
    
    With Sheets("Master Sheet")
        Dim rw
        If IsArray(gl) Then
            For Each rw In gl
                .Cells(rw, tc) = tv
            Next
        Else
            .Cells(gl, tc) = tv
        End If
    End With

End Sub

 

[AllyGraham]

Thank you JGordon11, what you have created for me does work. I have made the changes for my actual sheets and references, as the example I gave did not reflect the actual placement of the data in the rows or columns, and it was not actually the same cell reference between the sheets. I am very thankful as you have helped a lot with this project.