Excel data transpose unique values with VbScript

edTech

New Member
Joined
Dec 8, 2019
Messages
33
Office Version
  1. 2019
Platform
  1. Windows
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.

testtest1test2test3test4
testingoakcherryredpink
blueyellowbrown
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 = ""
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!

lrobbo314

Well-known Member
Joined
Jul 14, 2008
Messages
3,150
Office Version
  1. 365
Platform
  1. Windows
Something like this.

Book1
ABCDEFGH
1ValueTitletesttest1test2test3test4
2TestingtestTestingoakcherryredpink
3oaktest1blueyellowbrown
4cherrytest2green
5yellowtest1
6greentest1
7browntest2
8bluetest
9redtest3
10pinktest4
Sheet5


VBA Code:
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

New Member
Joined
Dec 8, 2019
Messages
33
Office Version
  1. 2019
Platform
  1. Windows
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
 

Watch MrExcel Video

Forum statistics

Threads
1,129,915
Messages
5,638,965
Members
417,062
Latest member
Canucks21

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
Top