SOLVED
Home

Excel formula to transfer values into new table with their types as column headers

%3CLINGO-SUB%20id%3D%22lingo-sub-816681%22%20slang%3D%22en-US%22%3EExcel%20formula%20to%20transfer%20values%20into%20new%20table%20with%20their%20types%20as%20column%20headers%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-816681%22%20slang%3D%22en-US%22%3E%3CP%3EHello%2C%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EI%20have%20a%20specific%20problem%20and%20am%20wondering%20if%20there%20is%20a%20formula%20or%20something%20to%20that%20effect%20that%20I%20can%20use.%3C%2FP%3E%3CP%3EThe%20question%20in%20the%20title%20may%20be%20a%20little%20confusing%2C%20so%20here%20is%20an%20example.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3ELet's%20say%20I%20have%20a%20sheet%20containing%20variables%20and%20their%20type%20in%20the%20cell%20just%20left%20of%20it%2C%20respectively%3A%3C%2FP%3E%3CTABLE%20border%3D%221%22%3E%3CTBODY%3E%3CTR%3E%3CTD%3ECar%3A%3C%2FTD%3E%3CTD%3EHonda%3C%2FTD%3E%3CTD%3EMotorbike%3A%3C%2FTD%3E%3CTD%3EBMW%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%3ECar%3A%3C%2FTD%3E%3CTD%3EBMW%3C%2FTD%3E%3CTD%3E%26nbsp%3B%3C%2FTD%3E%3CTD%3E%26nbsp%3B%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%3EMotorbike%3A%3C%2FTD%3E%3CTD%3ESuzuki%3C%2FTD%3E%3CTD%3E%26nbsp%3B%3C%2FTD%3E%3CTD%3E%26nbsp%3B%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%3EMotorbike%3A%3C%2FTD%3E%3CTD%3EYamaha%3C%2FTD%3E%3CTD%3EPlane%3A%3C%2FTD%3E%3CTD%3EConcorde%3C%2FTD%3E%3C%2FTR%3E%3C%2FTBODY%3E%3C%2FTABLE%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EAnd%20I%20want%20it%20to%20look%20like%20this%20instead%3A%3C%2FP%3E%3CTABLE%20border%3D%221%22%3E%3CTBODY%3E%3CTR%3E%3CTD%3ECar%3C%2FTD%3E%3CTD%3EMotorbike%3C%2FTD%3E%3CTD%3EPlane%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%3EHonda%3C%2FTD%3E%3CTD%3EBMW%3C%2FTD%3E%3CTD%3E%26nbsp%3B%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%3EBMW%3C%2FTD%3E%3CTD%3E%26nbsp%3B%3C%2FTD%3E%3CTD%3E%26nbsp%3B%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%3E%26nbsp%3B%3C%2FTD%3E%3CTD%3ESuzuki%3C%2FTD%3E%3CTD%3E%26nbsp%3B%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%3E%26nbsp%3B%3C%2FTD%3E%3CTD%3EYamaha%3C%2FTD%3E%3CTD%3EConcorde%3C%2FTD%3E%3C%2FTR%3E%3C%2FTBODY%3E%3C%2FTABLE%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EIs%20there%20a%20convenient%20way%20to%20transform%20the%20data%20like%20this%3F%3CBR%20%2F%3E%3CBR%20%2F%3EAny%20help%20is%20appreciated!%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-LABS%20id%3D%22lingo-labs-816681%22%20slang%3D%22en-US%22%3E%3CLINGO-LABEL%3EExcel%3C%2FLINGO-LABEL%3E%3C%2FLINGO-LABS%3E%3CLINGO-SUB%20id%3D%22lingo-sub-818528%22%20slang%3D%22en-US%22%3ERe%3A%20Excel%20formula%20to%20transfer%20values%20into%20new%20table%20with%20their%20types%20as%20column%20headers%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-818528%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F396536%22%20target%3D%22_blank%22%3E%40SourcePilot%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EYou%20may%20try%20the%20following%20macro%20to%20transform%20the%20data%20into%20the%20desired%20format.%3C%2FP%3E%3CP%3EIn%20the%20attached%2C%20click%20the%20button%20called%20%22Transform%20Data%22%20on%20Sheet1%20to%20run%20the%20code.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CPRE%20class%3D%22lia-code-sample%20language-markup%22%3E%3CCODE%3ESub%20TransformData()%0ADim%20wsData%20As%20Worksheet%2C%20wsOutupt%20As%20Worksheet%0ADim%20x%2C%20y()%2C%20dict%2C%20it%0ADim%20i%20As%20Long%2C%20j%20As%20Long%0ADim%20c%0A%0AApplication.ScreenUpdating%20%3D%20False%0A%0ASet%20wsData%20%3D%20Worksheets(%22Sheet1%22)%20%20%20%20%20%20%20'Data%20Sheet%0A%0AOn%20Error%20Resume%20Next%0ASet%20wsOutupt%20%3D%20Worksheets(%22Output%22)%20%20%20%20%20'Transformed%20data%20will%20be%20placed%20on%20this%20sheet%0AwsOutupt.Cells.Clear%0AOn%20Error%20GoTo%200%0A%0AIf%20wsOutupt%20Is%20Nothing%20Then%0A%20%20%20%20Set%20wsOutupt%20%3D%20Worksheets.Add(after%3A%3DwsData)%0A%20%20%20%20wsOutupt.Name%20%3D%20%22Output%22%20%20%20%20%20%20%20%20%20%20%20%20'Transformed%20data%20will%20be%20placed%20on%20this%20sheet%0AEnd%20If%0A%0Ax%20%3D%20wsData.Range(%22A1%22).CurrentRegion.value%0ASet%20dict%20%3D%20CreateObject(%22Scripting.Dictionary%22)%0A%0AFor%20i%20%3D%201%20To%20UBound(x%2C%201)%0A%20%20%20%20For%20j%20%3D%201%20To%20UBound(x%2C%202)%0A%20%20%20%20%20%20%20%20If%20InStr(x(i%2C%20j)%2C%20%22%3A%22)%20%26gt%3B%200%20Then%0A%20%20%20%20%20%20%20%20%20%20%20%20dict.Item(x(i%2C%20j))%20%3D%20%22%22%0A%20%20%20%20%20%20%20%20End%20If%0A%20%20%20%20Next%20j%0ANext%20i%0A%0AIf%20dict.Count%20%3D%200%20Then%0A%20%20%20%20MsgBox%20%22Data%20not%20in%20desired%20format!%22%2C%20vbExclamation%0A%20%20%20%20Exit%20Sub%0AEnd%20If%0A%0AReDim%20y(1%20To%20UBound(x%2C%201)%20%2B%201%2C%201%20To%20dict.Count)%0A%0Aj%20%3D%200%0A%0AFor%20Each%20it%20In%20dict.keys%0A%20%20%20%20j%20%3D%20j%20%2B%201%0A%20%20%20%20y(1%2C%20j)%20%3D%20it%0ANext%20it%0A%0AFor%20i%20%3D%201%20To%20UBound(x%2C%201)%0A%20%20%20%20For%20j%20%3D%201%20To%20UBound(x%2C%202)%0A%20%20%20%20%20%20%20%20If%20InStr(x(i%2C%20j)%2C%20%22%3A%22)%20%26gt%3B%200%20Then%0A%20%20%20%20%20%20%20%20%20%20%20%20c%20%3D%20Application.Match(x(i%2C%20j)%2C%20Application.Index(y%2C%201%2C%200)%2C%200)%0A%20%20%20%20%20%20%20%20%20%20%20%20If%20Not%20IsError(c)%20Then%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20y(i%20%2B%201%2C%20c)%20%3D%20x(i%2C%20j%20%2B%201)%0A%20%20%20%20%20%20%20%20%20%20%20%20End%20If%0A%20%20%20%20%20%20%20%20End%20If%0A%20%20%20%20Next%20j%0ANext%20i%0A%0AwsOutupt.Range(%22A1%22).Resize(UBound(y%2C%201)%2C%20UBound(y%2C%202)).value%20%3D%20y%0A%0AWith%20wsOutupt.Rows(1)%0A%20%20%20%20.Replace%20%22%3A%22%2C%20%22%22%0A%20%20%20%20.Font.Bold%20%3D%20True%0A%20%20%20%20.Font.Size%20%3D%2012%0AEnd%20With%0A%0AWith%20wsOutupt.Range(%22A1%22).CurrentRegion%0A%20%20%20%20.Columns.AutoFit%0A%20%20%20%20.Borders.Color%20%3D%20vbBlack%0AEnd%20With%0A%0AwsOutupt.Select%0A%0AApplication.ScreenUpdating%20%3D%20True%0AEnd%20Sub%3C%2FCODE%3E%3C%2FPRE%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-826454%22%20slang%3D%22en-US%22%3ERe%3A%20Excel%20formula%20to%20transfer%20values%20into%20new%20table%20with%20their%20types%20as%20column%20headers%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-826454%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F394231%22%20target%3D%22_blank%22%3E%40Subodh_Tiwari_sktneer%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%3CP%3EIt%20works%20like%20a%20charm!%3CBR%20%2F%3E%3CBR%20%2F%3EThanks%20a%20bunch%2C%20Subodh%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-826657%22%20slang%3D%22en-US%22%3ERe%3A%20Excel%20formula%20to%20transfer%20values%20into%20new%20table%20with%20their%20types%20as%20column%20headers%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-826657%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F396536%22%20target%3D%22_blank%22%3E%40SourcePilot%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%3CP%3EYou're%20welcome!%20Glad%20it%20worked%20as%20desired.%3C%2FP%3E%3C%2FLINGO-BODY%3E
SourcePilot
New Contributor

Hello,

 

I have a specific problem and am wondering if there is a formula or something to that effect that I can use.

The question in the title may be a little confusing, so here is an example.

 

Let's say I have a sheet containing variables and their type in the cell just left of it, respectively:

Car:HondaMotorbike:BMW
Car:BMW  
Motorbike:Suzuki  
Motorbike:YamahaPlane:Concorde

 

And I want it to look like this instead:

CarMotorbikePlane
HondaBMW 
BMW  
 Suzuki 
 YamahaConcorde

 

Is there a convenient way to transform the data like this?

Any help is appreciated!

3 Replies
Solution

@SourcePilot 

 

You may try the following macro to transform the data into the desired format.

In the attached, click the button called "Transform Data" on Sheet1 to run the code.

 

Sub TransformData()
Dim wsData As Worksheet, wsOutupt As Worksheet
Dim x, y(), dict, it
Dim i As Long, j As Long
Dim c

Application.ScreenUpdating = False

Set wsData = Worksheets("Sheet1")       'Data Sheet

On Error Resume Next
Set wsOutupt = Worksheets("Output")     'Transformed data will be placed on this sheet
wsOutupt.Cells.Clear
On Error GoTo 0

If wsOutupt Is Nothing Then
    Set wsOutupt = Worksheets.Add(after:=wsData)
    wsOutupt.Name = "Output"            'Transformed data will be placed on this sheet
End If

x = wsData.Range("A1").CurrentRegion.value
Set dict = CreateObject("Scripting.Dictionary")

For i = 1 To UBound(x, 1)
    For j = 1 To UBound(x, 2)
        If InStr(x(i, j), ":") > 0 Then
            dict.Item(x(i, j)) = ""
        End If
    Next j
Next i

If dict.Count = 0 Then
    MsgBox "Data not in desired format!", vbExclamation
    Exit Sub
End If

ReDim y(1 To UBound(x, 1) + 1, 1 To dict.Count)

j = 0

For Each it In dict.keys
    j = j + 1
    y(1, j) = it
Next it

For i = 1 To UBound(x, 1)
    For j = 1 To UBound(x, 2)
        If InStr(x(i, j), ":") > 0 Then
            c = Application.Match(x(i, j), Application.Index(y, 1, 0), 0)
            If Not IsError(c) Then
                y(i + 1, c) = x(i, j + 1)
            End If
        End If
    Next j
Next i

wsOutupt.Range("A1").Resize(UBound(y, 1), UBound(y, 2)).value = y

With wsOutupt.Rows(1)
    .Replace ":", ""
    .Font.Bold = True
    .Font.Size = 12
End With

With wsOutupt.Range("A1").CurrentRegion
    .Columns.AutoFit
    .Borders.Color = vbBlack
End With

wsOutupt.Select

Application.ScreenUpdating = True
End Sub

 

 

 

@SourcePilot 

You're welcome! Glad it worked as desired.

Related Conversations
Tabs and Dark Mode
cjc2112 in Discussions on
46 Replies
flashing a white screen while open new tab
Deleted in Discussions on
14 Replies
Security Community Webinars
Valon_Kolica in Security, Privacy & Compliance on
13 Replies
Stable version of Edge insider browser
HotCakeX in Discussions on
35 Replies
Extentions Synchronization
Deleted in Discussions on
3 Replies
How to Prevent Teams from Auto-Launch
chenrylee in Microsoft Teams on
29 Replies