Link to home
Create AccountLog in
Avatar of Cartillo
CartilloFlag for Malaysia

asked on

Copy only Selected Data

Hi Experts,

I would like to request Experts help modify the attached script. The script is able to copy only unique titles from Column C (Data Sheet) to Detail Sheet. is that possible to modify this script to copy only "Type1" and "Type3" (Column B - Data sheet ) to Detail sheet? Hope Experts will help me create this feature.  
Sub Filter()
    Dim k(), ka, I As Long, d As String, n As Long, c As Long
    With Worksheets("Data")
        ka = .Range("a6:d" & .Range("a" & .Rows.Count).End(xlUp).Row)
    End With
    ReDim k(1 To UBound(ka, 1), 1 To 5)
    With CreateObject("scripting.dictionary")
        .comparemode = 1
        For I = 1 To UBound(ka, 1)
            If IsDate(ka(I, 1)) Then d = ka(I, 1): GoTo Nxt ' Like "*(*)" Then
            If Len(ka(I, 3)) Then
                If Not .exists(ka(I, 3)) Then
                    n = n + 1: k(n, 1) = d
                    For c = 1 To UBound(ka, 2)
                        k(n, c + 1) = ka(I, c)
                    .Add ka(I, 3), Nothing
                End If
            End If
    End With
    If n Then
        With Worksheets("Detail")
            Union(.Range("b2").Resize(n), .Range("e2").Resize(n)).NumberFormat = "[h]:mm"
            .Range("a2").Resize(n, UBound(k, 2)) = k
        End With
    End If
End Sub

Open in new window

Avatar of krishnakrkc
Flag of India image

Link to home
Create an account to see this answer
Signing up is free. No credit card required.
Create Account
Avatar of Cartillo


Hi Kris,

Thanks a lot for the help.
Hi Kris,

Hope you will consider this request, which is dwelled with your solution. I believe we only able to speed up the data processing with "scripting. dictionary."
Hi Kris,

Hope you will consider this request, as for now no solution being given. Most likely not everyone well verse with "scripting. dictionary."