Macro that transposes the information as follows

[nahomi23]

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 1	a	b	c	d
		b1	c1	d1
Categoría 2	z	w	x	y
		w1	x1	y1
		w2	x2	y2
		w3	x3	y3
		w4	x4	y4

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

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

 

[BarryL]

Hello, I could produce your results on a separate sheet using the below. Can you see if it fits your requirements:

Sub transp()
Dim lr As Long, rng As Range, i As Integer, ref As Range, wslr As Long
Dim sh As Worksheet, ws As Worksheet

Set sh = ThisWorkbook.Sheets(1)
Set ws = ThisWorkbook.Sheets(2)


lr = sh.Range("A" & Rows.Count).End(xlUp).Row

For Each rng In sh.Range("A1:A" & lr)

If rng.Value Like "Cat*" Then
    wslr = ws.Range("B" & ws.Rows.Count).End(xlUp).Row
If wslr = 1 Then
    Set ref = ws.Range("A1")
Else
    Set ref = ws.Range("A" & wslr + 1)
End If

ref.Value = rng.Value
GoTo skippy
End If

If Not IsNumeric(Right(rng.Value, 1)) Then
    lc = ws.Cells(ref.Row, Columns.Count).End(xlToLeft).Column
        ws.Cells(ref.Row, lc + 1).Value = rng.Value
GoTo skippy
End If

If IsNumeric(Right(rng.Value, 1)) Then
    i = Right(rng.Value, 1)
        lc = ws.Cells(ref.Row + i, Columns.Count).End(xlToLeft).Column
            ws.Cells(ref.Row + i, lc + 1).Value = rng.Value
End If
skippy:
Next
End Sub

 

[Fluff]

Hi & welcome to MrExcel.
Just change this line

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

to

If r(fr, 1) Like "Cat*" Then

 

[nahomi23]

Hello, I could produce your results on a separate sheet using the below. Can you see if it fits your requirements:

Sub transp()
Dim lr As Long, rng As Range, i As Integer, ref As Range, wslr As Long
Dim sh As Worksheet, ws As Worksheet

Set sh = ThisWorkbook.Sheets(1)
Set ws = ThisWorkbook.Sheets(2)


lr = sh.Range("A" & Rows.Count).End(xlUp).Row

For Each rng In sh.Range("A1:A" & lr)

If rng.Value Like "Cat*" Then
    wslr = ws.Range("B" & ws.Rows.Count).End(xlUp).Row
If wslr = 1 Then
    Set ref = ws.Range("A1")
Else
    Set ref = ws.Range("A" & wslr + 1)
End If

ref.Value = rng.Value
GoTo skippy
End If

If Not IsNumeric(Right(rng.Value, 1)) Then
    lc = ws.Cells(ref.Row, Columns.Count).End(xlToLeft).Column
        ws.Cells(ref.Row, lc + 1).Value = rng.Value
GoTo skippy
End If

If IsNumeric(Right(rng.Value, 1)) Then
    i = Right(rng.Value, 1)
        lc = ws.Cells(ref.Row + i, Columns.Count).End(xlToLeft).Column
            ws.Cells(ref.Row + i, lc + 1).Value = rng.Value
End If
skippy:
Next
End Sub

Thanks!, another question if you give me the information in this way

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 I have to show it this way

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

How would the conditional or what should I do to show it to me


Thanks for your help

 

[Fluff]

Welcome to the MrExcel Message Board!

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: Macro that transposes the information as follows
If you have posted the question at more places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.

 

[Fluff]

Did you see post#3 as we posted about the same time?

 

[nahomi23]

Macro that transposes the information as follows

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) Categoria 1 a b c d

www.excelforum.com

Macro that transposes the information as follows

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..

techcommunity.microsoft.com

 

[Fluff]

Thanks for the links, did you try the change I suggested in post#3?

 

[nahomi23]

Thanks for the links, did you try the change I suggested in post#3?

Yes of course but the proposed solution does not serve me anymore, however thanks

 

[Fluff]

In what way? It provides the same output that you have shown?