VBA Macro - Transpose with conditions

marcelo_abreu

New Member
Joined
Feb 23, 2018
Messages
3
So I need your help! Firstly I am a student and don't really know much about VBA, because my teacher skipped those classes, whatever...

I have a table with a long number of rows and data in columns.I wanna transpose them to rows and deleting duplicates, so it's better to review the data.
I'm thinking about doing this with a macro of course.

The table I got is similar to the next one:
[TABLE="class: grid, width: 150"]
<tbody>[TR]
[TD]Unit Procudure[/TD]
[TD]Unit Operation[/TD]
[TD]Operation Parameter[/TD]
[TD]Parameter Value[/TD]
[TD]Eng. Units[/TD]
[TD]Origin[/TD]
[/TR]
[TR]
[TD]17CH43_SD1251_STARTUP[/TD]
[TD]BEGIN_SD:1[/TD]
[TD]CIP_ST[/TD]
[TD]Rest[/TD]
[TD][/TD]
[TD]Value[/TD]
[/TR]
[TR]
[TD]17CH43_SD1251_STARTUP[/TD]
[TD]BEGIN_SD:1[/TD]
[TD]CND_ST[/TD]
[TD]Rest[/TD]
[TD][/TD]
[TD]Value[/TD]
[/TR]
[TR]
[TD]17CH43_SD1251_STARTUP[/TD]
[TD]BEGIN_SD:1[/TD]
[TD]DESC[/TD]
[TD]1[/TD]
[TD]min[/TD]
[TD]Value[/TD]
[/TR]
[TR]
[TD]17CH43_SD1251_STARTUP[/TD]
[TD]BEGIN_SD:1[/TD]
[TD]DRY_ST[/TD]
[TD]on[/TD]
[TD][/TD]
[TD]Value[/TD]
[/TR]
[TR]
[TD]17CH43_SD1251_STARTUP[/TD]
[TD]DRYING_SD:1[/TD]
[TD]CIP_ST[/TD]
[TD]Active[/TD]
[TD][/TD]
[TD]Value[/TD]
[/TR]
[TR]
[TD]17CH43_SD1251_STARTUP[/TD]
[TD]DRYING_SD:1[/TD]
[TD]CND_ST[/TD]
[TD]Rest[/TD]
[TD][/TD]
[TD]Value[/TD]
[/TR]
[TR]
[TD]17CH43_SD1251_STARTUP[/TD]
[TD]DRYING_SD:1[/TD]
[TD]DESC[/TD]
[TD]2[/TD]
[TD]min[/TD]
[TD]Value[/TD]
[/TR]
[TR]
[TD]17CH43_SD1251_STARTUP[/TD]
[TD]DRYING_SD:1[/TD]
[TD]DRY_ST[/TD]
[TD]off[/TD]
[TD][/TD]
[TD]Value[/TD]
[/TR]
[TR]
[TD]17CH43_SD1251_STARTUP[/TD]
[TD]DRYING_SD:2[/TD]
[TD]CIP_ST[/TD]
[TD]Rest[/TD]
[TD][/TD]
[TD]Value[/TD]
[/TR]
[TR]
[TD]17CH43_SD1251_STARTUP[/TD]
[TD]DRYING_SD:2[/TD]
[TD]CND_ST[/TD]
[TD]Active[/TD]
[TD][/TD]
[TD]Value[/TD]
[/TR]
[TR]
[TD]17CH43_SD1251_STARTUP[/TD]
[TD]DRYING_SD:2[/TD]
[TD]DESC[/TD]
[TD]3[/TD]
[TD]min[/TD]
[TD]Value[/TD]
[/TR]
[TR]
[TD]17CH43_SD1251_STARTUP[/TD]
[TD]DRYING_SD:2[/TD]
[TD]DRY_ST[/TD]
[TD]off[/TD]
[TD][/TD]
[TD]Value[/TD]
[/TR]
[TR]
[TD]17CH43_SD1251_STARTUP[/TD]
[TD]OPCHECK_SD:1[/TD]
[TD]DESC[/TD]
[TD]4[/TD]
[TD]min[/TD]
[TD]Value[/TD]
[/TR]
[TR]
[TD]17CH43_SD1251_STARTUP[/TD]
[TD]OPCHECK_SD:1[/TD]
[TD]B070_OUT_MAX[/TD]
[TD]100[/TD]
[TD]%[/TD]
[TD]Value[/TD]
[/TR]
[TR]
[TD]17CH43_SD1251_STARTUP[/TD]
[TD]OPCHECK_SD:1[/TD]
[TD]B070_OUT_MIN[/TD]
[TD]10[/TD]
[TD]%[/TD]
[TD]Value[/TD]
[/TR]
[TR]
[TD]17CH43_SD1251_STARTUP[/TD]
[TD]OPCHECK_SD:1[/TD]
[TD]Q4TYPE[/TD]
[TD]none[/TD]
[TD][/TD]
[TD]Value[/TD]
[/TR]
[TR]
[TD]17CH43_SD1251_STARTUP[/TD]
[TD]SETUP_SD:1[/TD]
[TD]B070_OUT_MAX[/TD]
[TD]50[/TD]
[TD]%[/TD]
[TD]Value[/TD]
[/TR]
[TR]
[TD]17CH43_SD1251_STARTUP[/TD]
[TD]SETUP_SD:1[/TD]
[TD]B070_OUT_MIN[/TD]
[TD]20[/TD]
[TD]%[/TD]
[TD]Value[/TD]
[/TR]
[TR]
[TD]17CH43_SD1251_STARTUP[/TD]
[TD]SETUP_SD:1[/TD]
[TD]DESC[/TD]
[TD]5[/TD]
[TD]min[/TD]
[TD]Value[/TD]
[/TR]
</tbody>[/TABLE]

So with a macro and a table like this (the actual table has over 300 rows and more operations and procedures):
-----

[TABLE="class: grid, width: 100"]
<tbody>[TR]
[TD]Unit Procedure[/TD]
[TD]17CH43_SD1251_STARTUP[/TD]
[TD]17CH43_SD1251_STARTUP[/TD]
[TD]17CH43_SD1251_STARTUP[/TD]
[TD]17CH43_SD1251_STARTUP[/TD]
[TD]17CH43_SD1251_STARTUP[/TD]
[TD]17CH43_SD1251_STARTUP[/TD]
[TD]17CH43_SD1251_STARTUP[/TD]
[/TR]
[TR]
[TD]Unit Operation[/TD]
[TD]BEGIN_SD:1[/TD]
[TD]DRYING_SD:1[/TD]
[TD]DRYING_SD:2[/TD]
[TD]OPCHECK_SD:1[/TD]
[TD]SETUP_SD:1[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Operation Parameter[/TD]
[TD]Parameter Value[/TD]
[TD]Parameter Value[/TD]
[TD]Parameter Value[/TD]
[TD]Parameter Value[/TD]
[TD]Parameter Value[/TD]
[TD]Eng. Units[/TD]
[TD]Origin[/TD]
[/TR]
[TR]
[TD]CIP_ST[/TD]
[TD]Rest[/TD]
[TD]Active[/TD]
[TD]Rest[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Value[/TD]
[/TR]
[TR]
[TD]CND_ST[/TD]
[TD]Rest[/TD]
[TD]Rest[/TD]
[TD]Active[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Value[/TD]
[/TR]
[TR]
[TD]DESC[/TD]
[TD]1[/TD]
[TD]2[/TD]
[TD]3[/TD]
[TD]4[/TD]
[TD]5[/TD]
[TD]min[/TD]
[TD]Value[/TD]
[/TR]
[TR]
[TD]DRY_ST[/TD]
[TD]on[/TD]
[TD]off[/TD]
[TD]on[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Value[/TD]
[/TR]
[TR]
[TD]Q4TYPE[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]none[/TD]
[TD][/TD]
[TD][/TD]
[TD]Value[/TD]
[/TR]
[TR]
[TD]B070_OUT_MAX[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]100[/TD]
[TD]50[/TD]
[TD]%[/TD]
[TD]Value[/TD]
[/TR]
[TR]
[TD]B070_OUT_MIN[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]10[/TD]
[TD]20[/TD]
[TD]%[/TD]
[TD]Value[/TD]
[/TR]
</tbody>[/TABLE]

This would be the kind of result I'm tryna work on but can't figure it out.
Don't really know if it's possible.. If not I'd like some help on just the operation parameter and parameter value.

Excuse my english in any case of bad spelling, I'm portuguese.
Thank you, Marcelo!

 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Try this for results on sheet2.
This works for the thread data, but I fancy your real data might be somewhat different !!!!!

Code:
[COLOR=navy]Sub[/COLOR] MG23Feb04
[COLOR=navy]Dim[/COLOR] Dn          [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] n           [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Ac [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] Rng         [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Dic         [COLOR=navy]As[/COLOR] Object
[COLOR=navy]Dim[/COLOR] k           [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Dim[/COLOR] p           [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Dim[/COLOR] c           [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] Sp          [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Dim[/COLOR] Txt         [COLOR=navy]As[/COLOR] [COLOR=navy]String[/COLOR]
   [COLOR=navy]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
    [COLOR=navy]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
        Dic.CompareMode = 1
            [COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
                .CompareMode = vbTextCompare
   
   [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
            Txt = Dn.Value & "," & Dn.Offset(, 1).Value
            [COLOR=navy]If[/COLOR] Not Dic.exists(Txt) [COLOR=navy]Then[/COLOR]
                [COLOR=navy]Set[/COLOR] Dic(Txt) = CreateObject("Scripting.Dictionary")
            [COLOR=navy]End[/COLOR] If
            [COLOR=navy]If[/COLOR] Not Dn = Rng(1) [COLOR=navy]Then[/COLOR] .Item(Dn.Offset(, 2).Value) = Empty
                Dic(Txt).Add (Dn.Offset(, 2).Value), Dn
    [COLOR=navy]Next[/COLOR] Dn
   
   
   ReDim ray(1 To Rng.Count, 1 To Dic.Count + 2)
   c = 3
    [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] k [COLOR=navy]In[/COLOR] Dic.keys
        Ac = Ac + 1
        Sp = Split(k, ",")
        ray(1, Ac) = Sp(0)
        ray(2, Ac) = Sp(1)
        ray(3, Ac) = IIf(Ac = 1, "Operation Parameter", "Parameter Value")
        ray(1, Dic.Count + 1) = Sp(0)
        ray(1, Dic.Count + 2) = Sp(0)
        ray(3, UBound(ray, 2) - 1) = "Eng.Units"
        ray(3, UBound(ray, 2)) = "Origin"
    [COLOR=navy]Next[/COLOR] k
       
       [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] p [COLOR=navy]In[/COLOR] .keys: c = c + 1: ray(c, 1) = p: [COLOR=navy]Next[/COLOR] p
    
[COLOR=navy]End[/COLOR] With
[COLOR=navy]Dim[/COLOR] R [COLOR=navy]As[/COLOR] Range
[COLOR=navy]For[/COLOR] Ac = 2 To UBound(ray, 2) - 2
    [COLOR=navy]For[/COLOR] n = 4 To c
        [COLOR=navy]If[/COLOR] Dic(ray(1, Ac) & "," & ray(2, Ac)).exists(ray(n, 1)) [COLOR=navy]Then[/COLOR]
                [COLOR=navy]Set[/COLOR] R = Dic(ray(1, Ac) & "," & ray(2, Ac)).Item(ray(n, 1))
                ray(n, Ac) = R.Offset(, 3).Value
                [COLOR=navy]If[/COLOR] R.Offset(, 4).Value <> "" [COLOR=navy]Then[/COLOR] ray(n, UBound(ray, 2) - 1) = R.Offset(, 4)
                [COLOR=navy]If[/COLOR] R.Offset(, 5).Value <> "" [COLOR=navy]Then[/COLOR] ray(n, UBound(ray, 2)) = R.Offset(, 5)
        [COLOR=navy]End[/COLOR] If
    [COLOR=navy]Next[/COLOR] n
[COLOR=navy]Next[/COLOR] Ac
 
[COLOR=navy]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, UBound(ray, 2))
    .Value = ray
    .Columns.AutoFit
    .Borders.Weight = 2
[COLOR=navy]End[/COLOR] [COLOR=navy]With[/COLOR]
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
 
Last edited:
Upvote 0
I try to run it on sheet 1 and it appears a window saying "run-time error 457: this key is already associated with an element of this collection" i press debug and it highlights the code "Dic(Txt).Add (Dn.Offset(, 2).Value), Dn" , any tips on how to fix it?

And

If I try to run it on Sheet 2 it appears a window saying "run-time error 9: subscript out of range" i press debug and it highlights the code "ray(2, Ac) = Sp(1)", any tips on how to fix it?

Thanks a lot, you guys are amazing!
Marcelo abreu
 
Upvote 0

Forum statistics

Threads
1,223,888
Messages
6,175,219
Members
452,619
Latest member
Shiv1198

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