pivot table not listing things in one row

@colts12og

Maybe you missed my solution with an filter in #15.

I can open the file from benishiryo.

Maybe you are not allowed to work with macros?

@oeldere,

#15 what are the step you are using and what what are you asking to filter?

I am able to use macros..

Moderators Note:

• As per Forum Rule #12, please don't quote whole posts unless necessary-- it's just clutter...Thanks.

HI COLTS12OG

This Code works on your Sample File. It'll need to be reworked a bit to handle your Real File. Please provide the information requested.

The Merge Rows Code was adapted from Code written by Jindon here
http://www.excelforum.com/excel-prog...e-columns.html

Run the Code with Sheet yty active. Let me know of issues.

Option Explicit
Dim LR As Long
Dim LC As Long
Dim Rng As Range
Dim i As Long

Sub Delete_Empty_Rows()
    With ActiveSheet
        LR = .Cells.Find("*", .Cells(Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious).Row

        LC = .Cells.Find(What:="*", After:=[A1], _
                SearchOrder:=xlByColumns, _
                SearchDirection:=xlPrevious).Column
        Set Rng = .Range("D2:D" & LR)
        With Rng
            For i = LR To 1 Step -1
                Application.ScreenUpdating = False
                If Not IsNull(Rng(i).Resize(1, LC - 3).Text) Then
                    Rng(i).EntireRow.Delete
                End If
            Next i
        End With
        .UsedRange.Replace What:="-*", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, _
                MatchCase:=False, SearchFormat:=False, ReplaceFormat:=True

        Call Merge_Rows
        
        .UsedRange.Offset(1, 3).NumberFormat = "h:mm"
    End With
    Application.ScreenUpdating = True

End Sub

' From http://www.excelforum.com/excel-programming-vba-macros/893749-merge-duplicate-rows-and-combine-data-in-some-of-the-same-columns.html
Sub Merge_Rows()
    Dim Dic As Object
    Set Dic = CreateObject("Scripting.Dictionary")
    With Range("A1").CurrentRegion
        For i = 1 To .Rows.Count
            If i < .Rows.Count Then
                If Not Dic.exists(.Cells(i, 2).Value) Then
                    Set Dic(.Cells(i, 2).Value) = .Rows(i).Range(Cells(1, 4), Cells(1 & LC))
                Else
                    Dic(.Cells(i, 2).Value).Value = _
                            .Parent.Evaluate(Dic(.Cells(i, 2).Value).Address & "&" _
                            & .Rows(i).Range(Cells(1, 4), Cells(1 & LC)).Address)
                    .Rows(i).EntireRow.Delete
                    i = i - 1
                End If
            End If
        Next
    End With
End Sub