Make a table from imported list in Excel - excel

Question

I get output from a program imported to Excel in the following format:
Item 1
1 10
2 10
3 20
5 20
8 30
13 30
Item 2
1 40
2 40
3 50
5 50
8 60
13 60
Item 3
1 50
2 50
3 40
5 40
8 30
13 30
Now, I want to create a table where the values for each item is placed next to each other as below:
Item 1 Item 2 Item 3
1 10 40 50
2 10 40 50
3 20 50 40
5 20 50 40
8 30 60 30
13 30 60 30
I can think of ways to do this using formulas with a combination of INDIRECT other functions, but I can see right away that it will be a huge pain. Is there a clever way of doing this?
My approach would be something like this:
=VLOOKUP($A6;indirect("A"&(6+G$5*$X$4):"D"&(30+G$5*$X$4));4;FALSE)
where my first lookup table is from A6:D30, the second from A32:D56. X4 contains the value 26 which is the number of rows for each Item, and G5:AA5 is 0, 1, 2 ....
I would place this besides the Item 1 list and drag it sideways and downwards. I think the procedure should work, but I get syntax error.
I don't have much experience writing VBA, but I'm capable of reading and understanding it.
UPDATE:
At Siddharth's request:

Answer 1

Can you check out this.
It assumes a fixed format as it is shown in your example.
It can be made dynamic, but then you need to customize the code.
Option Explicit
Sub test()
Dim oCollection As Collection
Dim oDict As Variant
Dim oItem As Object
Dim iCnt As Integer
Dim iCnt_B As Integer
Dim iCnt_items As Integer
Dim iCnt_records As Integer
Dim iID As Integer
Dim iValue As Integer
Dim strKey As Variant
'Nr of items
iCnt_items = 3
'Records per item
iCnt_records = 6
'This dictionary will store the items
Set oCollection = New Collection
'Store dictionaries in collection
For iCnt = 0 To iCnt_items - 1
Set oDict = CreateObject("Scripting.Dictionary")
For iCnt_B = 1 To iCnt_records
iID = ThisWorkbook.Sheets(1).Cells((iCnt * (iCnt_records) + (iCnt + 1) + iCnt_B), 1).Value
Debug.Print iID
iValue = ThisWorkbook.Sheets(1).Cells((iCnt * (iCnt_records) + (iCnt + 1) + iCnt_B), 2).Value
Debug.Print iValue
oDict.Add iID, iValue
Next iCnt_B
oCollection.Add oDict, "item " & iCnt
Next iCnt
'Write collection to sheet
iCnt = 0
For Each oItem In oCollection
iCnt = iCnt + 1
ThisWorkbook.Sheets(2).Cells(1, 1 + iCnt).Value = "item " & iCnt
iCnt_B = 0
For Each strKey In oItem.keys
iCnt_B = iCnt_B + 1
ThisWorkbook.Sheets(2).Cells(1 + iCnt_B, 1).Value = strKey
ThisWorkbook.Sheets(2).Cells(1 + iCnt_B, 1 + iCnt).Value = oItem(strKey)
Next
Next oItem
End Sub
Edit: sorry for interrupting the conversation -> I didn't follow up the comment section while programming.
Sidenote:
If the ranges you work with are dynamic, I would go with a dictionary.
The reason why I'm saying this is because the dictionary object uses indexing on its records.
The key - pair structure being: ID, value
allows you to directly access the values corresponding the given ID.
In your example you are working with a clear ID - value structure.
Using numeric id's would actually be the fastest.

Answer 2

Since I already worked on this... Here is another way..
Assumptions:
Data starts at row 5 in Sheet1
Output will be generated in Sheet2
Code:
The below code uses Collections and Formulas to achieve what you want.
Sub Sample()
Dim wsInput As Worksheet, wsOutput As Worksheet
Dim ColItems As New Collection, ColSubItems As New Collection
Dim lRow As Long, i As Long, N As Long
Dim itm
Set wsInput = ThisWorkbook.Sheets("Sheet1")
Set wsOutput = ThisWorkbook.Sheets("Sheet2")
With wsInput
lRow = .Range("B" & .Rows.Count).End(xlUp).Row
.Columns(1).Insert
.Range("A5:A" & lRow).Formula = "=IF(ISERROR(SEARCH(""Item"",B5,1)),A4,B5)"
For i = 5 To lRow
On Error Resume Next
If InStr(1, .Range("B" & i).Value, "item", vbTextCompare) Then
ColItems.Add .Range("B" & i).Value, CStr(.Range("B" & i).Value)
Else
ColSubItems.Add .Range("B" & i).Value, CStr(.Range("B" & i).Value)
End If
On Error GoTo 0
Next i
End With
With wsOutput
.Cells.ClearContents
N = 2
'~~> Create Header in Row 1
For Each itm In ColItems
.Cells(1, N).Value = itm
N = N + 1
Next
N = 2
'~~> Create headers in Col 1
For Each itm In ColSubItems
.Cells(N, 1).Value = itm
N = N + 1
Next
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
lcol = .Cells(1, .Columns.Count).End(xlToLeft).Column
j = 2
For i = 2 To lcol
.Range(.Cells(j, i), .Cells(lRow, i)).Formula = "=SUMIFS(" & _
wsInput.Name & _
"!C:C," & wsInput.Name & _
"!A:A," & .Name & _
"!$" & _
Split(.Cells(, i).Address, "$")(1) & _
"$1," & _
wsInput.Name & _
"!B:B," & _
.Name & _
"!A:A)"
Next i
.Rows("1:" & lRow).Value = .Rows("1:" & lRow).Value
End With
wsInput.Columns(1).Delete
End Sub
Screenshot:

Answer 3

This is what I have tried.
Sheet 1 contains the data. The result is generated in Sheet 2
Sub createTable()
Dim counter As Integer
Dim countRow As Integer
Dim flag As Boolean
Dim cellAddress As String
flag = True
countRow = 2
counter = 2
ThisWorkbook.Sheets("Sheet1").Activate
For Each cell In Range("a:a")
If counter = 2 Then
If InStr(1, cell.Value, "Item") Then
ThisWorkbook.Sheets("Sheet2").Activate
ActiveSheet.Cells(1, counter).Value = cell.Value
firstItem = cell.Value
counter = counter + 1
End If
Else
ThisWorkbook.Sheets("Sheet2").Activate
If InStr(1, cell.Value, "Item") Then
ThisWorkbook.Sheets("Sheet2").Activate
ActiveSheet.Cells(1, counter).Value = cell.Value
counter = counter + 1
flag = False
End If
If flag = True Then
Cells(cell.Row, cell.Column) = cell.Value
End If
End If
If cell.Value = vbNullString Then
Exit For
End If
Next cell
ThisWorkbook.Sheets("Sheet1").Activate
Application.CutCopyMode = False
Dim counteradd As Integer
counteradd = 2
For Each cell In Range("a:a")
v = cell.Value
If InStr(1, cell.Value, "Item") Then
If cell.Offset(1, 1).Select <> vbNullString Then
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Sheet2").Select
Cells(2, counteradd).Select
ActiveSheet.Paste
Application.CutCopyMode = False
counteradd = counteradd + 1
ThisWorkbook.Sheets("Sheet1").Activate
End If
End If
Next cell
End Sub