Excel Transpose duplicate name for every criteria

F

Fimpass

New Member
Joined
Oct 31, 2017
Messages
2
Hi all.

I got a question regarding a file that I'm working on since yesterday.
I got this table:
fWEkBJB.png


I need the data to be like this:
DveLwza.png


So If a person has 3 OK's The code needs to return the column header and create a duplicate for every column header. I got this code now.
Code: 
Sub BlankLine()Dim Col As Variant, coll As Long, LastRow As Long, i As Long, j As Long, StartRow As Long, LR2 As Long


        Col = "a"
        StartRow = 1




LastRow = Sheet1.Cells(Rows.Count, Col).End(xlUp).Row


Application.ScreenUpdating = False
With ActiveSheet
j = 0
s = 1


For i = 2 To LastRow
 LR2 = Sheet2.Cells(Rows.Count, Col).End(xlUp).Row
 coll = WorksheetFunction.CountIf(Sheet1.Range("I" & i, "AG" & i), "OK")
 For j = 1 To coll
  Sheet2.Range("A" & LR2 + j).Value = Sheet1.Range("A" & i).Value
  Sheet2.Range("B" & LR2 + j).Value = Sheet1.Range("B" & i).Value
  Sheet2.Range("C" & LR2 + j).Value = Sheet1.Range("C" & i).Value
  Sheet2.Range("D" & LR2 + j).Value = Sheet1.Range("D" & i).Value
  Sheet2.Range("E" & LR2 + j).Value = Sheet1.Range("E" & i).Value
  Sheet2.Range("F" & LR2 + j).Value = Sheet1.Range("F" & i).Value
  Sheet2.Range("G" & LR2 + j).Value = Sheet1.Range("G" & i).Value
  Sheet2.Range("H" & LR2 + j).Value = Sheet1.Range("H" & i).Value
  Sheet2.Range("I" & LR2 + j).Value = Sheet1.Range("H1").Offset(0, j).Value
  s = s + 1
 Next j


Next i
End With
Application.ScreenUpdating = True




End Sub

The code above creates all I need EXCEPT "I" column that is messed up. I know that I need a variable that counts the column where the OK is and return the header, but I don't know how to make it work.

Please help a bit.
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
Sort by date Sort by votes
Hi & welcome to the board
Try this
Code: 
Sub BlankLine()

Application.ScreenUpdating = False

    Dim Cl As Range
    Dim Cnt As Long

    With Sheet4
        For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
            Cnt = WorksheetFunction.Countif(Cl.Offset(, 8).Resize(, 25), "OK")
            If Not Cnt = 0 Then
                sheet9.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(1 * Cnt, 8).Value = Cl.Resize(, 8).Value
                sheet9.Range("I" & Rows.Count).End(xlUp).Offset(1).Resize(Cnt).Value = _
                    Cl.Offset(, 8).Resize(, 25).SpecialCells(xlConstants).Value
            End If
        Next Cl
    End With
    
Application.ScreenUpdating = True

End Sub
 
Upvote 0
Forgot to mention that you'll need to change the sheet references to match yours
 
Upvote 0
[TABLE="width: 896"]
<colgroup><col width="64" span="14" style="width:48pt"> </colgroup><tbody>[TR]
[TD="width: 64"]name[/TD]
[TD="class: xl24, width: 64, align: right"]001[/TD]
[TD="class: xl24, width: 64, align: right"]002[/TD]
[TD="class: xl24, width: 64, align: right"]003[/TD]
[TD="class: xl24, width: 64, align: right"]004[/TD]
[TD="class: xl24, width: 64, align: right"]005[/TD]
[TD="class: xl24, width: 64, align: right"]006[/TD]
[TD="class: xl24, width: 64, align: right"]007[/TD]
[TD="class: xl24, width: 64, align: right"]008[/TD]
[TD="class: xl24, width: 64, align: right"]009[/TD]
[TD="class: xl24, width: 64, align: right"]010[/TD]
[TD="width: 64"][/TD]
[TD="width: 64"][/TD]
[TD="width: 64"][/TD]
[/TR]
[TR]
[TD]bill[/TD]
[TD]ok[/TD]
[TD][/TD]
[TD]ok[/TD]
[TD]ok[/TD]
[TD][/TD]
[TD]ok[/TD]
[TD][/TD]
[TD][/TD]
[TD]ok[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]fred[/TD]
[TD][/TD]
[TD]ok[/TD]
[TD]ok[/TD]
[TD][/TD]
[TD]ok[/TD]
[TD]ok[/TD]
[TD][/TD]
[TD]ok[/TD]
[TD]ok[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]bill[/TD]
[TD="class: xl24, align: right"]001[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]bill[/TD]
[TD="class: xl24, align: right"]003[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]bill[/TD]
[TD="class: xl24, align: right"]004[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]bill[/TD]
[TD="class: xl24, align: right"]006[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]bill[/TD]
[TD="class: xl24, align: right"]009[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]fred[/TD]
[TD="class: xl24, align: right"]002[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]fred[/TD]
[TD="class: xl24, align: right"]003[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]fred[/TD]
[TD="class: xl24, align: right"]005[/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 4"]this macro produced the lower table[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]fred[/TD]
[TD="class: xl24, align: right"]006[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]fred[/TD]
[TD="class: xl24, align: right"]008[/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 2"]Sub Macro5()[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]fred[/TD]
[TD="class: xl24, align: right"]009[/TD]
[TD][/TD]
[TD][/TD]
[TD]'[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 2"]' Macro5 Macro[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 4"]' Macro recorded 31/10/2017 by bob[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]'[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]'[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 3"] Dim myname(50), mytest(50)[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 2"] rrow = 3[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 2"] For j = 2 To 3[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 2"] For k = 2 To 11[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 5"] If Cells(j, k) = "ok" Then GoTo 50 Else GoTo 100[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 3"]50 Sum = Sum + 1[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 3"] myname(Sum) = Cells(j, 1)[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 3"] mytest(Sum) = Cells(1, k)[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 2"]100 Next k[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 2"] For z = 1 To Sum[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 2"] rrow = rrow + 1[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 3"] Cells(rrow, 1) = myname(z)[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 3"] Cells(rrow, 2) = mytest(z)[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD] Next z[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="colspan: 2"] Sum = 0[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD] Next j[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]End Sub[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
VBA Copy/Paste from different workbooks
Replies
1
Views
385
NdNoviceHlp
NdNoviceHlp
U
  • Solved
Doing a search for text within a call, from entries in a defined name range
Replies
3
Views
127
Upex
U
B
  • Question Question
VBA Compatibility Issues with Excel for Mac
Replies
1
Views
38
Dan_W
D
K
  • Question Question
create fixtures but 2 vs 2
Replies
7
Views
205
kerm007
K
M
  • Solved
vba to sum up each column for each employee on column (A)
Replies
6
Views
341
kvsrinivasamurthy
K

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top