Macro that transposes the information as follows

nahomi23

New Member
Joined
Mar 9, 2021
Messages
7
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hello,

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

They give me the data in this way

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


And the macro should convert it like this


Categoría 1abcd
b1c1d1
Categoría 2zwxy
w1x1y1
w2x2y2
w3x3y3
w4x4y4

At the moment I have this as a code but it does not do me well


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


I would greatly appreciate your help
 
Last edited by a moderator:
 
Upvote 0

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
In what way? It provides the same output that you have shown?
What happens is that I try to edit this post since I had provided the data wrong but I did not find the option so I started a new thread with the correct data but they assimilated that it was the same but not the data changes and the way these are displayed Likewise
 
Upvote 0
In that case can you please post the correct data & output to this thread.
 
Upvote 0
If the correct data & output is the same as post#4, how should the code determine where one output row ends & the next begins?
 
Upvote 0

Forum statistics

Threads
1,215,549
Messages
6,125,473
Members
449,233
Latest member
Deardevil

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