CODEWITHSUNDEEP
excelvba
John Redyns
John Redyns

Reputation: 5913

Excel macro column splitting

Looking for help on a macro to take chunks of data on further rows, and place them into columns instead.

I've attached a picture to depict this. All of the chunks of data will split determined by the first column, 1 or 2 in the picture. I simply want to move chunk two up and next to 1. The only problem I've run into is that for each chunk, the number of columns is variable.

Edit: Image link incase the embedded isn't showing up: enter link description here

enter image description here

Would this be relatively close?

Sub macro() 
Dim wav_name As String 

Range("A1").Select 

Do While ActiveCell.Value <> "" 
ActiveCell.Offset(0, 2).Select 
wav_name = ActiveCell.Value 
ActiveCell.Offset(1, 0).Select 

Do 
    If ActiveCell.Value = wav_name Then 
        ActiveCell.Offset(1, 0).Select 
    Else 
        Exit Do 
    End If 
Loop 

Range(ActiveCell.Offset(0, -2), ActiveCell.End(xlDown)).Select 
Selection.Cut 
ActiveCell.End(xlUp).Offset(0, 3).Select 
ActiveSheet.Paste 

Loop 

Range("A1").Select 
End Sub

Upvotes: 1

Views: 1340

Answers (1)

Pynner
Pynner

Reputation: 1017

What you have there is pretty workable with a one key exception.

Your cut selection is only grabbing the first row of data. You will need to change it to

Range(ActiveCell).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select

To handle the variable number of columns, you can capture the last column in section one by adding a varabile (i.e. LastCol) and putting the following code in your Do Loop

LastCol = Activecell.End(xlToRight).Column

Then replace the 3 in your last offset statement with your variable

Note that you can refactor the code to remove many of the select statements (includeing the ones I have mentioned above) if you need to improve the preformance of your code, but what you have written will work for you.

EDIT: Here is what your end code would look like

Sub macro() 
Dim wav_name As String 
Dim LastCol as Long

Range("A1").Select 

Do While ActiveCell.Value <> "" 
ActiveCell.Offset(0, 2).Select 
wav_name = ActiveCell.Value 
ActiveCell.Offset(1, 0).Select 
LastCol = Activecell.End(xlToRight).Column

Do 
    If ActiveCell.Value = wav_name Then 
        ActiveCell.Offset(1, 0).Select 
    Else 
        Exit Do 
    End If 
Loop 

Range(ActiveCell.Offset(0, -2), ActiveCell.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select

Selection.Cut 
ActiveCell.End(xlUp).Offset(0, LastCol +1).Select 
ActiveSheet.Paste 

Loop 

Range("A1").Select 
End Sub

I haven't tested this, so you may have to do some debugging... but it is now logically correct.

Upvotes: 1

Related Questions