VBA to copy and paste unique values into seperate worksheets

[ThinkCentree]

Hi everyone,

I'm working on a VBA which will scroll down column K of a data page selecting the unique values and pasting them to different worksheet templates.

e.g. the first unique value will be pasted into cell A2 of the first pre formatted worksheet ("Template1"), and the second unique value found will be pasted into call A2 of the second pre formatted worksheet ("Template2") and so on until there are no further unique values in the column. There won't ever be more than 10 unique values so I'm just going to have 10 templates available and the next section of my macro can ignore the empty ones.

So far I've scrambled together the following code to select the unique values but I'm having a bit of trouble putting together a loop which will paste the data in the way I would like.

If anyone could help me out it would be much appreciated

    Dim a, i As Long, ii As Long, w(), x, y
    Const keyCol As Long = 1
    Dim Lrow As Long
    Dim s As Worksheet
    
    
    Lrow = Range("K" & Rows.Count).End(xlUp).Row
    
    a = Sheets("Data Page").Range("K3:K" & Lrow)
    
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 2 To UBound(a, 1)
            If Not .exists(a(i, keyCol)) Then
                ReDim w(1 To UBound(a, 2), 1 To 1)
            Else
                w = .Item(a(i, keyCol))
                ReDim Preserve w(1 To UBound(w, 1), 1 To UBound(w, 2) + 1)
            End If
            For ii = 1 To UBound(a, 2)
                w(ii, UBound(w, 2)) = a(i, ii)
            Next
            .Item(a(i, keyCol)) = w
        Next
        x = .keys: y = .Items
    End With

 

[mirabeau]

Hi everyone,

I'm working on a VBA which will scroll down column K of a data page selecting the unique values and pasting them to different worksheet templates.

e.g. the first unique value will be pasted into cell A2 of the first pre formatted worksheet ("Template1"), and the second unique value found will be pasted into call A2 of the second pre formatted worksheet ("Template2") and so on until there are no further unique values in the column. There won't ever be more than 10 unique values so I'm just going to have 10 templates available and the next section of my macro can ignore the empty ones.

So far I've scrambled together the following code to select the unique values but I'm having a bit of trouble putting together a loop which will paste the data in the way I would like.

If anyone could help me out it would be much appreciated
...

Does this code give what you want?

Sub templates()
Dim c
With CreateObject("scripting.dictionary")
.comparemode = 1
On Error Resume Next
For Each c In Range("k1").Resize(Cells(Rows.Count, "k").End(3).Row).Value
    If Not .Item(c) = 1 Then
        Sheets("Template" & .Count).Range("A2") = c
        .Item(c) = 1
    End If
Next c
On Error GoTo 0
End With
End Sub

 

[ThinkCentree]

Yes this is working perfectly!

Thanks very much.