Excel VBA Transpose Variable Column Range to Variable Rows

Question

Hello StackOverFlow Community,

I started working with excel vba not too long ago and could really use some help with a somewhat complex problem.

I have a spreadsheet with a column of "Prime" parts and its "Alternative" Parts below it. I need to create a macro that will transpose the Variable Alternative parts to the right of its associated Prime part. So for the Example below, in Column A "P" are Prime Parts and "A" are Altenates :

A |

1P |

1A |

2P |

2A |

3P |

3A |

I trying to create a macro that will give me the following results:

A || B || C || D |

1P | 1A | 1A | 1A

1A |

2P | 2A | 2A

2A |

3P | 3A

3A |

Below is the Code that I was able to come up with, but all of the Alternate parts consolidate into one range and transpose to the first Prime part of the list. I understand that this may not be the best method for what I am trying to accomplish. I am open to all suggestion and looking forward to hearing some awesome solutions.

Please note that the Bolded Prime parts in the above example are actually highlighted on my spreadsheet which would explain the "colorindex = 6" in the code

Sub NewHope()

Dim cell As Range
Dim LastRow As Long
Dim Prime As Range
Dim alt As Range


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

For Each cell In Range("A2:A" & LastRow)
    If cell.Interior.ColorIndex = 6 Then
        If Prime Is Nothing Then
            Set Prime = cell
        End If
    Else
        If alt Is Nothing Then
            Set alt = cell
        Else
            Set alt = Union(alt, cell)
        End If

    End If
Next

alt.Copy
Prime.Offset(0, 4).PasteSpecial Transpose:=True

End sub

I'm trying to figure out if I need to understand how alternative primes work in order to help with a solution... I doubt it. As long as there is a pattern there are always a number of different ways to rearrange data into a different pattern. If your code already identifies (with color) which numbers need to be the "headings" then it should be very simple. Instead of coloring the cell, move it? — ashleedawg
– ashleedawg, Commented Nov 24, 2017 at 21:17
@ashleedawg There is no pattern. There can be any number of alternate parts to each prime part. Hope that clarifies — Todd Choi
– Todd Choi, Commented Nov 24, 2017 at 21:23
Did you tried using arrays? How do you know if a part is alternate of a Prime? — user8753746
– user8753746, Commented Nov 24, 2017 at 21:30
Is there more code than what you posted? It doesn't make sense to me (unrelated to Primes) for a few reasons but it's a little hard to follow. Do you know how to Step through your code, one line at a time, watching the variables & output? Sounds like you know exactly what it needs to be doing, step by step, so stepping through the code will probably make the specific issue obvious. Check out this article by the amazing Chip Pearson, King of Excel. — ashleedawg
– ashleedawg, Commented Nov 24, 2017 at 21:33
@DavidG. I have not tried using arrays as I am not too familiar with that function. The alternate parts are the cells below the Prime cell right above them. — Todd Choi
– Todd Choi, Commented Nov 24, 2017 at 21:37

user8753746 · Accepted Answer · 2017-11-24 21:50:09Z

2

Try this code:

Sub test()
Dim cell As Range
Dim LastRow As Long
Dim PrimeRow As Long
Dim PrimeColumn As Long

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

For Each cell In Range("A2:A" & LastRow)
    If cell.Interior.ColorIndex = 6 Then
        PrimeRow = cell.Row
        PrimeColumn = cell.Column + 1
    Else
        Cells(PrimeRow, PrimeColumn).Value = cell.Value
        PrimeColumn = PrimeColumn + 1
    End If
Next

End Sub

answered Nov 24, 2017 at 21:50

user8753746

Sign up to request clarification or add additional context in comments.

5 Comments

Todd Choi Over a year ago

@David.G The code you provided did exactly what I asked for! However, I have another problem that hopefully you can solve.

Todd Choi Over a year ago

The code transposed the "--A" cells, but I am actually trying to transpose the cells in the column next to those cells. I hope that is clear to you.

user8753746 Over a year ago

Hello Todd, great this code helped you. As this solved your initial question, please mark my answer as solved your question. You can add some lines bellow the Else statement to validate if the cell in the next column has data and copy the value to the next column in the Prime row.

Todd Choi Over a year ago

Thank you again. I marked as answered. Is there any way you can provide some more direction on this suggestion? I am still trying to fully understand the code you provided.

Todd Choi Over a year ago

I figured it out! Thank you again for the help!

user4039065 · Accepted Answer · 2017-11-24 21:50:14Z

0

If Prime Is Nothing Then

The above code does not seem to do what you require; it does not reset the 'prime' cell since after the first location of a 'prime' cell, Prime will never be nothing again.

dim r as long, pr as long

For r=2 to Range("A" & Rows.Count).End(xlUp).Row
    If cells(r, "A").Interior.ColorIndex = 6 Then
        pr = r
    Else
        cells(pr, columns.count).end(xltoleft).offset(0,1) = cells(r, "A").value
    End If
Next

This code would be better with a properly referenced parent worksheet reference.

answered Nov 24, 2017 at 21:50

user4039065

Comments

EEM · Accepted Answer · 2017-11-24 23:29:41Z

This solution uses AutoFilter, Range.Areas and Arrays in order to avoid looping through each of the cells, improving the processing speed...

    Sub TEST_Transpose_Alternates_To_Prime()
    Dim wsTrg As Worksheet, rgTrg As Range
    Dim rgPrime As Range, rgAlter As Range
    Dim rgArea As Range, aAlternates As Variant
    Dim L As Long

        Set wsTrg = ThisWorkbook.Worksheets("DATA")    'Change as required
        With wsTrg
            Application.Goto .Cells(1), 1
            If Not (.AutoFilter Is Nothing) Then .Cells(1).AutoFilter
            Set rgTrg = .Cells(6, 2).CurrentRegion.Columns(1)  'Change as required
        End With

        Rem Set Off Application Properties to improve speed
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual

        With rgTrg
            Rem Set Primes Range
            .AutoFilter Field:=1, Criteria1:="=*P"
            Set rgPrime = .Offset(1).Resize(-1 + .Rows.Count).SpecialCells(xlCellTypeVisible)

            Rem Set Alternates Range
            .AutoFilter Field:=1, Criteria1:="=*A"
            Set rgAlter = .Offset(1).Resize(-1 + .Rows.Count).SpecialCells(xlCellTypeVisible)

            Rem Clear Filters
            .AutoFilter
        End With

        Rem Validate Prime & Alternate Ranges
        If rgPrime.Areas.Count <> rgAlter.Areas.Count Then Exit Sub

        Rem Post Alternates besides each Prime
        rgTrg.Cells(1).Offset(0, 1).Value = "Alternates..."

        For Each rgArea In rgAlter.Areas

            With rgPrime

                L = 1 + L
                aAlternates = rgArea.Value2

                If rgArea.Cells.Count > 1 Then
                    aAlternates = WorksheetFunction.Transpose(aAlternates)
                    .Areas(L).Cells(1).Offset(0, 1).Resize(1, UBound(aAlternates)).Value = aAlternates

                Else
                    .Areas(L).Cells(1).Offset(0, 1).Value = aAlternates

        End If: End With: Next

        Rem Refresh Application Properties
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True
        Application.EnableEvents = True

        End Sub

Collectives™ on Stack Overflow

Excel VBA Transpose Variable Column Range to Variable Rows

A |

A || B || C || D |

3 Answers 3

5 Comments

Comments

Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

A |

A || B || C || D |

3 Answers 3

5 Comments

Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related