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)
                    Next
                    .Add ka(I, 3), Nothing
                End If
            End If
Nxt:
        Next
    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

Data-Copy.xls
ASKER CERTIFIED SOLUTION
Avatar of krishnakrkc
krishnakrkc
Flag of India image

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

ASKER

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."  

https://www.experts-exchange.com/questions/27441000/Filter-Data.html
Hi Kris,

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