Excel data transpose unique values with VbScript

[edTech]

Hello, I am new to this forum and i am struggling with data i have in excel that i need to transpose using VbScript. I have data as noted below. Any help that can be provided would be most appreciated.

Value Title
Testing test
oak test1
cherry test2
yellow test1
green test1
brown test2
blue test
red test3
pink test4

I need my data to look like this with pulling unique of the titles and matching the values that correspond and pasting it to the correct column.

test	test1	test2	test3	test4
testing	oak	cherry	red	pink
blue	yellow	brown
	green

Current Code:

Option Explicit

Dim objReadXL, objReadWB, objReadWS, Lst_row, Lst_col, intRow,

Const xltoleft = -4159
Const xlup = -4162
Const xlDown = -4162
Const xlYes = 1

'Create excel object to read
Set objReadXL = CreateObject("Excel.Application")
objReadXL.Visible = True

Set objReadWB = objReadXL.Workbooks.Open("C:\Scripts\Testing\test.xlsx") 'Change the path of your excel file
Set objReadWS = objReadWB.Sheets("Sheet1") 'Change the name of sheet as in your file

Do until objReadWS.Cells(intRow, 2).Value = ""

 

[lrobbo314]

Something like this.

Book1
	A	B	C	D	E	F	G	H
1	Value	Title		test	test1	test2	test3	test4
2	Testing	test		Testing	oak	cherry	red	pink
3	oak	test1		blue	yellow	brown
4	cherry	test2			green
5	yellow	test1
6	green	test1
7	brown	test2
8	blue	test
9	red	test3
10	pink	test4
Sheet5

Sub Unwind()
Dim SD As Object:       Set SD = CreateObject("Scripting.Dictionary")
Dim CO As Integer:      CO = 4 'Outputting to Column D
Dim AR() As Variant:    AR = Range("A2:B" & Range("A" & Rows.Count).End(xlUp).Row).Value
Dim SP() As String

For i = 1 To UBound(AR)
    SD(AR(i, 2)) = SD(AR(i, 2)) & AR(i, 1) & ","
Next i

For Each k In SD.keys
    SP = Split(SD(k), ",")
    Cells(1, CO) = k
    Cells(2, CO).Resize(UBound(SP) + 1, 1) = Application.Transpose(SP)
    CO = CO + 1
Next k

End Sub

 

[edTech]

Thank you lrobbo314, but i am trying to make into VbScript formality and I get an error. Here is the revised code for VbScript, but it is not working

Dim SD, CO, AR, SP, k, i
Const xlup = -4159
Set objReadXL = CreateObject("Excel.Application")
Set objReadWB = ObjReadXL.Workbooks.Open("C:\Scripts\Test.xlsx")
Set objReadWS = objReadWB.Sheets("Sheet1")
Call Unwind()
Sub Unwind()
Set SD = CreateObject("Scripting.Dictionary")
CO = 4 'Outputting to Column D
AR = Range("A2:B" & objReadWS.Range("A" & objReadWS.Rows.Count).End(xlUp).Row).Value

For i = 1 To UBound(AR)
SD(AR(i, 2)) = SD(AR(i, 2)) & AR(i, 1) & ","
Next i
For Each k In SD.keys
SP = Split(SD(k), ",")
Cells(1, CO) = k
Cells(2, CO).Resize(UBound(SP) + 1, 1) = objReadWS.Transpose(SP)
CO = CO + 1
Next
End Sub