Macro that transposes the information as follows

%3CLINGO-SUB%20id%3D%22lingo-sub-2196371%22%20slang%3D%22en-US%22%3EMacro%20that%20transposes%20the%20information%20as%20follows%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-2196371%22%20slang%3D%22en-US%22%3E%3CP%3E%3CSPAN%3EHello%2C%3C%2FSPAN%3E%3CBR%20%2F%3E%3CSPAN%3EI%20need%20your%20help%20to%20make%20a%20macro%20that%20does%20the%20following%2C%3C%2FSPAN%3E%3C%2FP%3E%3CP%3E%3CBR%20%2F%3E%3CSPAN%3EThey%20give%20me%20the%20data%20in%20this%20way%20(all%20this%20information%20is%20in%20column%20A)%3A%3C%2FSPAN%3E%3C%2FP%3E%3CDIV%3E%3CTABLE%20border%3D%220%22%20width%3D%2280%22%20cellspacing%3D%220%22%20cellpadding%3D%220%22%3E%3CTBODY%3E%3CTR%3E%3CTD%20width%3D%2280%22%20height%3D%2221%22%3ECategor%C3%ADa%201%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%20width%3D%2280%22%20height%3D%2221%22%3Ea%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%20width%3D%2280%22%20height%3D%2221%22%3Eb%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%20width%3D%2280%22%20height%3D%2221%22%3Ec%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%20width%3D%2280%22%20height%3D%2221%22%3Ed%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%20width%3D%2280%22%20height%3D%2221%22%3Eb1%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%20width%3D%2280%22%20height%3D%2221%22%3Ec1%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%20width%3D%2280%22%20height%3D%2221%22%3Ed1%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%20width%3D%2280%22%20height%3D%2221%22%3Eb1%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%20width%3D%2280%22%20height%3D%2221%22%3Ec1%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%20width%3D%2280%22%20height%3D%2221%22%3Ed1%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%20width%3D%2280%22%20height%3D%2221%22%3ECategor%C3%ADa%202%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%20width%3D%2280%22%20height%3D%2221%22%3Ez%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%20width%3D%2280%22%20height%3D%2221%22%3Ew%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%20width%3D%2280%22%20height%3D%2221%22%3Ex%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%20width%3D%2280%22%20height%3D%2221%22%3Ey%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%20width%3D%2280%22%20height%3D%2221%22%3Exy%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%20width%3D%2280%22%20height%3D%2221%22%3Ew1%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%20width%3D%2280%22%20height%3D%2221%22%3Ex1%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%20width%3D%2280%22%20height%3D%2221%22%3Ey1%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%20width%3D%2280%22%20height%3D%2221%22%3Ew2%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%20width%3D%2280%22%20height%3D%2221%22%3Ex2%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%20width%3D%2280%22%20height%3D%2221%22%3Ey2%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%20width%3D%2280%22%20height%3D%2221%22%3Exy2%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%20width%3D%2280%22%20height%3D%2221%22%3Ew3%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%20width%3D%2280%22%20height%3D%2221%22%3Ex3%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%20width%3D%2280%22%20height%3D%2221%22%3Ey3%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%20width%3D%2280%22%20height%3D%2221%22%3Ew4%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%20width%3D%2280%22%20height%3D%2221%22%3Ex4%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%20width%3D%2280%22%20height%3D%2221%22%3Ey4%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%20width%3D%2280%22%20height%3D%2221%22%3Exy4%3C%2FTD%3E%3C%2FTR%3E%3C%2FTBODY%3E%3C%2FTABLE%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%3CSPAN%3EAnd%20the%20macro%20should%20convert%20it%20like%20this%3C%2FSPAN%3E%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CTABLE%20width%3D%22473%22%3E%3CTBODY%3E%3CTR%3E%3CTD%20width%3D%2280%22%3ECategor%C3%ADa%201%3C%2FTD%3E%3CTD%20width%3D%2280%22%3Ea%3C%2FTD%3E%3CTD%20width%3D%2280%22%3Eb%3C%2FTD%3E%3CTD%20width%3D%2280%22%3Ec%3C%2FTD%3E%3CTD%20width%3D%2280%22%3Ed%3C%2FTD%3E%3CTD%20width%3D%2273%22%3E%26nbsp%3B%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%20width%3D%2280%22%3E%26nbsp%3B%3C%2FTD%3E%3CTD%20width%3D%2280%22%3E%26nbsp%3B%3C%2FTD%3E%3CTD%20width%3D%2280%22%3Eb1%3C%2FTD%3E%3CTD%20width%3D%2280%22%3Ec1%3C%2FTD%3E%3CTD%20width%3D%2280%22%3Ed1%3C%2FTD%3E%3CTD%20width%3D%2273%22%3E%26nbsp%3B%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%20width%3D%2280%22%3ECategor%C3%ADa%202%3C%2FTD%3E%3CTD%20width%3D%2280%22%3Ez%3C%2FTD%3E%3CTD%20width%3D%2280%22%3Ew%3C%2FTD%3E%3CTD%20width%3D%2280%22%3Ex%3C%2FTD%3E%3CTD%20width%3D%2280%22%3Ey%3C%2FTD%3E%3CTD%20width%3D%2273%22%3Exy%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%20width%3D%2280%22%3E%26nbsp%3B%3C%2FTD%3E%3CTD%20width%3D%2280%22%3E%26nbsp%3B%3C%2FTD%3E%3CTD%20width%3D%2280%22%3Ew1%3C%2FTD%3E%3CTD%20width%3D%2280%22%3Ex1%3C%2FTD%3E%3CTD%20width%3D%2280%22%3Ey1%3C%2FTD%3E%3CTD%20width%3D%2273%22%3E%26nbsp%3B%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%20width%3D%2280%22%3E%26nbsp%3B%3C%2FTD%3E%3CTD%20width%3D%2280%22%3E%26nbsp%3B%3C%2FTD%3E%3CTD%20width%3D%2280%22%3Ew2%3C%2FTD%3E%3CTD%20width%3D%2280%22%3Ex2%3C%2FTD%3E%3CTD%20width%3D%2280%22%3Ey2%3C%2FTD%3E%3CTD%20width%3D%2273%22%3Exy2%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%20width%3D%2280%22%3E%26nbsp%3B%3C%2FTD%3E%3CTD%20width%3D%2280%22%3E%26nbsp%3B%3C%2FTD%3E%3CTD%20width%3D%2280%22%3Ew3%3C%2FTD%3E%3CTD%20width%3D%2280%22%3Ex3%3C%2FTD%3E%3CTD%20width%3D%2280%22%3Ey3%3C%2FTD%3E%3CTD%20width%3D%2273%22%3E%26nbsp%3B%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%20width%3D%2280%22%3E%26nbsp%3B%3C%2FTD%3E%3CTD%20width%3D%2280%22%3E%26nbsp%3B%3C%2FTD%3E%3CTD%20width%3D%2280%22%3Ew4%3C%2FTD%3E%3CTD%20width%3D%2280%22%3Ex4%3C%2FTD%3E%3CTD%20width%3D%2280%22%3Ey4%3C%2FTD%3E%3CTD%3E%26nbsp%3B%3C%2FTD%3E%3C%2FTR%3E%3C%2FTBODY%3E%3C%2FTABLE%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EAt%20the%20moment%20I%20have%20this%20code%20but%20it%20does%20not%20work%20well%20for%20me%3C%2FP%3E%3CPRE%3EOption%20Explicit%0AOption%20Base%201%0A%0ASub%20obtener()%0A%0ADim%20r%20As%20Range%2C%20fr%25%2C%20cr%25%0ASet%20r%20%3D%20Range(%22A1%22).CurrentRegion%0A%0ADim%20z%20As%20Object%2C%20zs%24%2C%20M(1%20To%205)%0ASet%20z%20%3D%20CreateObject(%22scripting.dictionary%22)%0ADim%20K%20As%20New%20Collection%2C%20ks%24%2C%20kn%25%0A%0A%0AOn%20Error%20Resume%20Next%20'para%20la%20K%0AFor%20fr%20%3D%201%20To%20r.Rows.Count%0A%0Azs%20%3D%20r(fr%2C%201).Row%0A%0AIf%20r(fr%2C%201)%20Like%20%22PO%3D*%22%20Then%0A%0Aks%20%3D%20%22%22%0AFor%20cr%20%3D%202%20To%204%0Aks%20%3D%20ks%20%26amp%3B%20r(fr%20%2B%20cr%2C%201)%0ANext%0AK.Add%20ks%2C%20ks%0A%0A%0AIf%20K.Count%20%26gt%3B%20kn%20Then%0Akn%20%3D%20K.Count%0AElse%0Afr%20%3D%20fr%20%2B%205%0AGoTo%20sigue%0AEnd%20If%0A%0A%0AM(1)%20%3D%20r(fr%2C%201)%0Afr%20%3D%20fr%20%2B%201%0AM(2)%20%3D%20r(fr%2C%201)%0Afr%20%3D%20fr%20%2B%201%0AM(3)%20%3D%20r(fr%2C%201)%0Afr%20%3D%20fr%20%2B%201%0AM(4)%20%3D%20r(fr%2C%201)%0Afr%20%3D%20fr%20%2B%201%0AM(5)%20%3D%20r(fr%2C%201)%0Az.Add%20zs%2C%20M()%0AElse%0Aks%20%3D%20%22%22%0AFor%20cr%20%3D%200%20To%202%0Aks%20%3D%20ks%20%26amp%3B%20r(fr%20%2B%20cr%2C%201)%0ANext%0AK.Add%20ks%2C%20ks%0A%0AIf%20K.Count%20%26gt%3B%20kn%20Then%0Akn%20%3D%20K.Count%0AElse%0Afr%20%3D%20fr%20%2B%202%0AGoTo%20sigue%0AEnd%20If%0A%0A'%20zs%20%3D%20r(fr%2C%201).Row%0AM(1)%20%3D%20Empty%0AM(2)%20%3D%20Empty%0AM(3)%20%3D%20r(fr%2C%201)%0Afr%20%3D%20fr%20%2B%201%0AM(4)%20%3D%20r(fr%2C%201)%0Afr%20%3D%20fr%20%2B%201%0AM(5)%20%3D%20r(fr%2C%201)%0Az.Add%20zs%2C%20M()%0AEnd%20If%0Asigue%3A%0ANext%0A%0AColumns(%22C%3AJ%22).ClearContents%0ARange(%22C2%22).Resize(z.Count%2C%205)%20%3D%20Application.Index(z.items%2C%200%2C%200)%0AEnd%20Sub%3C%2FPRE%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EWhich%20shows%20me%20the%20information%20in%20this%20way%3A%3C%2FP%3E%3CTABLE%20width%3D%22313%22%3E%3CTBODY%3E%3CTR%3E%3CTD%20width%3D%2280%22%3ECategor%C3%ADa%201%3C%2FTD%3E%3CTD%20width%3D%2280%22%3Ea%3C%2FTD%3E%3CTD%20width%3D%2280%22%3Eb%3C%2FTD%3E%3CTD%20width%3D%2273%22%3Ec%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%3E%26nbsp%3B%3C%2FTD%3E%3CTD%3E%26nbsp%3B%3C%2FTD%3E%3CTD%3Eb1%3C%2FTD%3E%3CTD%3Ec1%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%3ECategor%C3%ADa%202%3C%2FTD%3E%3CTD%3Ez%3C%2FTD%3E%3CTD%3Ew%3C%2FTD%3E%3CTD%3Ex%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%3E%26nbsp%3B%3C%2FTD%3E%3CTD%3E%26nbsp%3B%3C%2FTD%3E%3CTD%3Exy%3C%2FTD%3E%3CTD%3Ew1%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%3E%26nbsp%3B%3C%2FTD%3E%3CTD%3E%26nbsp%3B%3C%2FTD%3E%3CTD%3Ey1%3C%2FTD%3E%3CTD%3Ew2%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%3E%26nbsp%3B%3C%2FTD%3E%3CTD%3E%26nbsp%3B%3C%2FTD%3E%3CTD%3Ey2%3C%2FTD%3E%3CTD%3Exy2%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%3E%26nbsp%3B%3C%2FTD%3E%3CTD%3E%26nbsp%3B%3C%2FTD%3E%3CTD%3Ex3%3C%2FTD%3E%3CTD%3Ey3%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%3E%26nbsp%3B%3C%2FTD%3E%3CTD%3E%26nbsp%3B%3C%2FTD%3E%3CTD%3Ex4%3C%2FTD%3E%3CTD%3Ey4%3C%2FTD%3E%3C%2FTR%3E%3C%2FTBODY%3E%3C%2FTABLE%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3ECould%20someone%20help%20me%20on%20how%20to%20do%20this%20macro%3C%2FP%3E%3CP%3E%3CSPAN%3EI%20would%20greatly%20appreciate%20your%20help!%3C%2FSPAN%3E%3C%2FP%3E%3C%2FDIV%3E%3C%2FLINGO-BODY%3E%3CLINGO-LABS%20id%3D%22lingo-labs-2196371%22%20slang%3D%22en-US%22%3E%3CLINGO-LABEL%3EMacros%20and%20VBA%3C%2FLINGO-LABEL%3E%3C%2FLINGO-LABS%3E
Occasional Visitor

Hello,
I need your help to make a macro that does the following,


They give me the data in this way (all this information is in column A):

Categoría 1
a
b
c
d
b1
c1
d1
b1
c1
d1
Categoría 2
z
w
x
y
xy
w1
x1
y1
w2
x2
y2
xy2
w3
x3
y3
w4
x4
y4
xy4

 

And the macro should convert it like this

 

Categoría 1abcd 
  b1c1d1 
Categoría 2zwxyxy
  w1x1y1 
  w2x2y2xy2
  w3x3y3 
  w4x4y4 

 

At the moment I have this code but it does not work well for me

Option Explicit
Option Base 1

Sub obtener()

Dim r As Range, fr%, cr%
Set r = Range("A1").CurrentRegion

Dim z As Object, zs$, M(1 To 5)
Set z = CreateObject("scripting.dictionary")
Dim K As New Collection, ks$, kn%


On Error Resume Next 'para la K
For fr = 1 To r.Rows.Count

zs = r(fr, 1).Row

If r(fr, 1) Like "PO=*" Then

ks = ""
For cr = 2 To 4
ks = ks & r(fr + cr, 1)
Next
K.Add ks, ks


If K.Count > kn Then
kn = K.Count
Else
fr = fr + 5
GoTo sigue
End If


M(1) = r(fr, 1)
fr = fr + 1
M(2) = r(fr, 1)
fr = fr + 1
M(3) = r(fr, 1)
fr = fr + 1
M(4) = r(fr, 1)
fr = fr + 1
M(5) = r(fr, 1)
z.Add zs, M()
Else
ks = ""
For cr = 0 To 2
ks = ks & r(fr + cr, 1)
Next
K.Add ks, ks

If K.Count > kn Then
kn = K.Count
Else
fr = fr + 2
GoTo sigue
End If

' zs = r(fr, 1).Row
M(1) = Empty
M(2) = Empty
M(3) = r(fr, 1)
fr = fr + 1
M(4) = r(fr, 1)
fr = fr + 1
M(5) = r(fr, 1)
z.Add zs, M()
End If
sigue:
Next

Columns("C:J").ClearContents
Range("C2").Resize(z.Count, 5) = Application.Index(z.items, 0, 0)
End Sub

 

Which shows me the information in this way:

Categoría 1abc
  b1c1
Categoría 2zwx
  xyw1
  y1w2
  y2xy2
  x3y3
  x4y4

 

Could someone help me on how to do this macro

I would greatly appreciate your help!

0 Replies