List of distinct numbers withing range and another list extracted

Hello everybody
I have three columns >> Column D has a header (Type) which I want to extract distict numbers only from this column and result should be in Column I.....

In Column J I want to extract serials of that (Type) from Column B Based on values In Column C...

The attachment has a sample of the expected results

thanks Mr etaf
I need to do that by macros ...
I want to deal with hidden rows also . I'm sorry I didn't notice my hidden rows
And if possible the address may be useful .. If possible

Can you explain simply how did you do using Pivot Table.??

Hello,

etaf, thats for the pivot table suggestion. I have complimented your original idea with the VBA automation Yasser was looking for.

Yasser,

Place this code in a module in your workbook. Make sure that the file is like the sample. Once the code is in place run the procedure "MainCode"

Option Explicit

Const strSHEET_DATA As String = "Data"
Const strSHEET_DATA_CLEAN As String = "Clean Data"

Sub MainCode()
    
    On Error GoTo Error_Handler
    Call TurnExtrasOff
    Call CleanUpData
    Call CreatePivotTable

Exit_Handler:
    Call TurnExtrasOn
    Exit Sub
Error_Handler:

    MsgBox "There has been an error while trying to run the code", _
            vbCritical + vbOKOnly, "Error"
    Resume Exit_Handler

End Sub
    
Private Sub CleanUpData()

    Dim shCleanData As Worksheet
    Dim shData As Worksheet
    
    ' If the sheet clean data exists then remove it.
    On Error Resume Next
        Application.DisplayAlerts = False
        Sheets(strSHEET_DATA_CLEAN).Delete
        Application.DisplayAlerts = True
    On Error GoTo 0
    
    ' Add a new clean data sheet and asign variables.
    Set shData = Sheets(strSHEET_DATA)
    Set shCleanData = Sheets.Add
    shCleanData.Name = strSHEET_DATA_CLEAN
    
    ' Copy the data to a clean sheet.
    shData.Cells(2, 2).Resize(shData.UsedRange.Rows.Count, 3).Copy _
    Destination:=shCleanData.Cells(1, 1)
    
    ' Remove the extra spaces.
    shCleanData.Cells(2, 2).Resize(shCleanData.UsedRange.Rows.Count, 1).Offset(1).Replace "Paid", ""
    shCleanData.Columns("B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    
    ' Clean up
    Set shCleanData = Nothing
    Set shData = Nothing
    
End Sub

Private Sub CreatePivotTable()
    
    Dim shCleanData As Worksheet
    Dim pTable As PivotTable
    Dim pCache As PivotCache
        
    ' Start setting up the variables.
    Set shCleanData = Sheets(strSHEET_DATA_CLEAN)
    
    Set pCache = ActiveWorkbook.PivotCaches.Create(xlDatabase, shCleanData.Cells(1, 1).CurrentRegion.Address)
    Set pTable = pCache.CreatePivotTable(shCleanData.Range("I1"), "myTable")
    
       
    With pTable
        .PivotFields("Paid").Orientation = xlRowField
        .PivotFields("Paid").Position = 1
    
        .PivotFields("Ser.").Orientation = xlRowField
        .PivotFields("Ser.").Position = 2
        
        
        ' General settings
        .ColumnGrand = False
        .RowGrand = False
        .ShowDrillIndicators = False
        .RowAxisLayout xlTabularRow
        
        ' Remove all the subtotals.
        .PivotFields("Ser.").Subtotals(1) = False
        .PivotFields("Paid").Subtotals(1) = False
        .PivotFields("Type").Subtotals(1) = False
        
        ' Remove the blue stly in case you dont like it
        .TableStyle2 = ""
    End With
    
    ' Clean up
    Set shCleanData = Nothing
    Set pTable = Nothing
    Set pCache = Nothing
    
End Sub

Private Sub TurnExtrasOff()
    ' Turn off the extras to make code run faster.
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
End Sub

Private Sub TurnExtrasOn()
    ' Turn on the extras.
    With Application
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

Hope this helps

Bty I just noticed that there are hidden rows in your original data? Did you know that? Do you want to show them ? The code is grabbing those values as well right now.

Thanks

is it something like this that you want?
if so can be easily tidied up as however needed

Sub testx()
Dim a
Sheets("Data").Activate
Range("B2").CurrentRegion.Resize(, 2).Copy Range("G2")
With Range("G2").CurrentRegion.Resize(, 3)
    .Cells(2, 3) = 3: .Cells(2, 3).Resize(.Rows.Count - 1).DataSeries
    .Sort .Cells(2, 2), Header:=xlYes
    a = .Columns(2): .Columns(2) = .Columns(1).Value: .Columns(1) = a
    .Columns(3) = Evaluate("""C""&" & .Columns(3).Address)
    .Cells(1, 3) = "Address"
End With
End Sub

Thank you very much Mr. fredlo2010 but the results will be in Pivot Table..
Frankly I need to do my task without using pivot tables!! I'm sorry for time spent on this code but i appreciate your effort and thanka a lot Mr. fredlo2010
Mr. kalak your code results in error!!

Originally Posted by YasserKhalil

Mr. kalak your code results in error!!

That's very unhelpful from you YasserKhalil.
If you want help then be more specific about the error that you claim.
I had of course had tested that code on your data just as you posted it and it gave no error.
Did you try that code on the data as you posted it?
It appeared to give the result you asked for, apart from your own ambiguity about what you wanted done about the hidden rows that you didn't initially say were there.

Originally Posted by kalak

That's very unhelpful from you YasserKhalil.
If you want help then be more specific about the error that you claim.
I had of course had tested that code on your data just as you posted it and it gave no error.
Did you try that code on the data as you posted it?
It appeared to give the result you asked for, apart from your own ambiguity about what you wanted done about the hidden rows that you didn't initially say were there.

I'm very sorry Mr. Kalak for not demonstrating the error .. and for my own ambiguity !
I tested your code agian and it give the same error .. Now I read the error and noticed Merged and at once cancelled the merged cells and try again and it works like a charm
Thank you very much Mr. Kalak you are very helpful and sorry again

Just a point about first result I want the numbers only not the strings . I want to exclude text from the list >