Return list of all values that match criteria. Can this be done in a pivot?

[wakerider017]

I am not sure how to do this with a data set I have...

Data:

Customer	Group	Week 1	Week 2	Week 3	Week 4
Bob	A		Yes	Yes	Yes
Mark	B			Yes	Yes
Sue	A	Yes	Yes
Tim	A		Yes

<tbody>
</tbody>

List the week and each person that has a 'Yes' in that week.
Would prefer to do this in a pivot (if possible), as the actual data set is quite large (~50,000 records).

Filter to only show group A

Result:
Week 1	Sue
Week 2	Bob
Week 2	Sue
Week 2	Tim
Week 3	Bob
Week 4	Bob

<colgroup><col width="64" span="2" style="width:48pt"> </colgroup><tbody>
</tbody>

 

[Kamolga]

Not with pivot, your data is not properly set up for analyse (you should never have empty cells).

I would replace yes by the week number (select column, then ctrl+F and replace yes by Week1, select other column and replace by week 2, etc)
I would then copy the name and group and paste bellow last line, cut column week 2 and paste in 3rd column below week1 -> I end up with 3 columns (Name, group,Week Number) where pivot works perfectly and where I delete all empty lines (empty week number). You actually don't need a pivot anymore, filters will do.
If this operation is to be done once, it will take you avout 30 minutes (I barely touch the mouse, CTRL arrow down (with shift to select all) can make you win a lot of time). If this is data provided now and then, ir is worth to spend that time writing a macro.

 

[sandy666]

It's possible with PowerQuery
UnPivot weeks then use result table in normal PivotTable

[SIZE=1]let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Unpivoted Other Columns" = Table.UnpivotOtherColumns(Source, {"Customer", "Group"}, "Attribute", "Value")
in
    #"Unpivoted Other Columns"[/SIZE]

Source Table							Pivot Table
Customer	Group	Week 1	Week 2	Week 3	Week 4		Group	A
Bob	A		Yes	Yes	Yes
Mark	B			Yes	Yes		Attribute	Customer
Sue	A	Yes	Yes				Week 1	Sue
Tim	A		Yes				Week 2	Bob
							Week 2	Sue
							Week 2	Tim
							Week 3	Bob
							Week 4	Bob

 

[wakerider017]

Power Query solution seems nifty, but I have 2013 and will need to ask IT for permission to install on my PC. I may go ahead and do that.

Macro solution may work in the interim.

Thanks to both of you!

 

[Coffeeboo]

Hi all,

Ragarding the conversion of data from srock to PT friendly, I coded this macro for personal use. It works, though may take some time with 50k lines.
You'll just need to clean up the lines where the name fied is empty and then run a PT.

Best

Sub Verticalize_data()Dim i As Integer, j As Integer, k As Integer, n As Integer
Dim rowmovefirst As Integer, rowmovelast As Integer, colcopyfirst As Integer, colcopynb As Integer, rowheaders As Integer, colvalheader As Integer


Application.ScreenUpdating = False


If MsgBox("This macro will run on the active worksheet, are you willing to continue?", 4) <> 6 Then Exit Sub
If MsgBox("Please make sure you allocated one blank column to receive the verticalized header value", 1) <> 1 Then Exit Sub


colvalheader = InputBox("Please give the rank/number of said column, eg 3 for col C", "Which column is that?")
rowheaders = InputBox("Please give the rank/number of said row", "Which row contains headers for the data?")
rowmovefirst = InputBox("Please give the rank/number of said row", "Which is the first row of the data table to modify?")
rowmovelast = InputBox("Please give the rank/number of said row", "Which is the last row of the data table to modify?")
colcopyfirst = InputBox("Please give the rank/number of said column, eg 3 for col C", "Which is the first column containing data to verticalize?")
colcopynb = InputBox("Please give the number of data columns we're turning into data lines", "How many columns are we copying in a single one")


For i = rowmovelast To rowmovefirst Step -1


    For j = 0 To colcopynb - 2 Step 1
    ActiveSheet.Rows(i + 1).Insert
    Next j
    
    For k = 0 To colcopynb - 1 Step 1
    Cells(i + k, colvalheader).Value = Cells(rowheaders, colcopyfirst + k).Value
    Cells(i + k, colcopyfirst).Value = Cells(i, colcopyfirst + k).Value
        For n = 1 To colvalheader - 1 Step 1
        Cells(i + k, n).Value = Cells(i, n).Value
        Next n
    Next k
Next i


Application.ScreenUpdating = True


End Sub

 

[Kamolga]

Macro solution may work in the interim.

If you put your data with customer in A1 and last column is a week number (week 52 I guess), then this macro should do the job for you

Sub SetDat()Application.ScreenUpdating = True
[COLOR=#008000]'Define last row in Column A (last customer)[/COLOR]
Dim lr As Long
 lr = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
[COLOR=#008000]'Define last column in row 1 (week 52)[/COLOR]
Dim lc As Long
 lc = ActiveSheet.Cells(1, ActiveSheet.Columns.Count).End(xlToLeft).Column
[COLOR=#008000]'Change yes into week number[/COLOR]
Dim cCell As Range
    For Each cCell In Range(Cells(2, 3), Cells(lr, lc))
        If cCell <> "" Then
           cCell.Value = Cells(1, cCell.Column).Value
        End If
    Next cCell
[COLOR=#008000]'Cut each week and paste it in 3rd Column[/COLOR]
[COLOR=#008000]    'Define new last row[/COLOR]
    Dim nlr As Long
[COLOR=#008000]    'Loop through Column[/COLOR]
    Dim c As Long
        For c = 4 To lc
            nlr = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
[COLOR=#008000]            'Copy-paste Customer and group[/COLOR]
            Range(Cells(2, 1), Cells(lr, 2)).Copy
            Cells(nlr + 1, 1).Select
            ActiveSheet.Paste
            Application.CutCopyMode = False
[COLOR=#008000]            'Cut the column c[/COLOR]
            Range(Cells(2, c), Cells(lr, c)).Cut
[COLOR=#008000]            'Paste it[/COLOR]
            Cells(nlr + 1, 3).Select
            ActiveSheet.Paste
            Application.CutCopyMode = False
        Next c
[COLOR=#008000]    'Rename Week1 into week[/COLOR]
    Cells(1, 3) = "Week"
[COLOR=#008000]    'Erase other titles[/COLOR]
    Range(Cells(1, 4), Cells(1, lc)).ClearContents
[COLOR=#008000]    'Erase lines with no week number[/COLOR]
    Columns("C:C").SpecialCells(xlCellTyspeBlanks).EntireRow.Delete
Application.ScreenUpdating = True
End Sub

 

[Fluff]

Another option

Sub ResortData()
   Dim Ary As Variant, Oary As Variant
   Dim r As Long, c As Long, i As Long
   
   Ary = Sheets("Data").Range("A1").CurrentRegion.Value2
   ReDim Oary(1 To UBound(Ary) * UBound(Ary, 2), 1 To 2)
   
   For c = 3 To UBound(Ary, 2)
      For r = 2 To UBound(Ary)
         If Ary(r, c) = "Yes" Then
            i = i + 1
            Oary(i, 1) = Ary(1, c)
            Oary(i, 2) = Ary(r, 1)
         End If
      Next r
   Next c
   Sheets("New").Range("A1").Resize(i, 2).Value = Oary
End Sub