VBA Macro - Transpose with conditions

M

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

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
Sort by date Sort by votes
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
You must log in or register to reply here.

Similar threads

P
  • Solved
Counter in For Each loop
Replies
2
Views
447
Possum17
P
P
  • Question Question
Help with Vba Code
Replies
3
Views
478
Coyotex3
C
C
  • Question Question
Loop validation, copy output from same range and paste in different ranges
Replies
1
Views
726
RoryA
RoryA
T
  • Question Question
VBA Macro running, but not saving to Sharepoint
Replies
3
Views
771
Fluff
Fluff
K
  • Question Question
Excel Macro Newbie in need of help
Replies
1
Views
465
KaP76
K

Forum statistics

Threads
1,224,823
Messages
6,181,177
Members
453,021
Latest member
Justyna P

Share this page

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