Move Contents of Multiple Columns Recursively

[Yuffiek133]

Hello everyone,

My problem looks simple on paper, but I have no idea how to get a macro to do what I want it to do. Right now, I have it to the point where it will move the entire contents of a single row into column A, but I need it to move the contents of three columns, D, E, and F, row by row, into columns A, B, and C, underneath data that is currently in there. So it needs to create a new row under current data (row 1 = current, row 2 = new), move the current row D, E, F into that row, and move on to the next entry in D,E,F and move that into a new row under what would now be (row 3 = current, row 4 = new) and so on until the end of the sheet is reached.

My excel sheet is formatted thus:

[TABLE="width: 500"]
<tbody>[TR]
[TD]Michael[/TD]
[TD]B[/TD]
[TD]Albatross[/TD]
[TD]Major[/TD]
[TD]Major[/TD]
[TD]Major[/TD]
[TD]Town[/TD]
[TD]State[/TD]
[/TR]
[TR]
[TD]Sarah[/TD]
[TD]D[/TD]
[TD]Borden[/TD]
[TD]Major[/TD]
[TD]Major[/TD]
[TD]Major[/TD]
[TD]Town[/TD]
[TD]State[/TD]
[/TR]
[TR]
[TD]George[/TD]
[TD]R[/TD]
[TD]Martin[/TD]
[TD]Major[/TD]
[TD]Major[/TD]
[TD]Major[/TD]
[TD]Town[/TD]
[TD]State[/TD]
[/TR]
[TR]
[TD]Frank[/TD]
[TD]S[/TD]
[TD]Mint[/TD]
[TD]Major[/TD]
[TD]Major[/TD]
[TD]Major[/TD]
[TD]Town[/TD]
[TD]State[/TD]
[/TR]
[TR]
[TD]Louise[/TD]
[TD]L[/TD]
[TD]Peterson[/TD]
[TD]Major[/TD]
[TD]Major[/TD]
[TD]Major[/TD]
[TD]Town[/TD]
[TD]State[/TD]
[/TR]
</tbody>[/TABLE]

Each major is different by the way so it isn't copying the same data over and over again. At the end of the execution I need it to look like this:

[TABLE="width: 500"]
<tbody>[TR]
[TD]Michael[/TD]
[TD]B[/TD]
[TD]Albatross[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Town[/TD]
[TD]State[/TD]
[/TR]
[TR]
[TD]Major[/TD]
[TD]Major[/TD]
[TD]Major[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Sarah[/TD]
[TD]D[/TD]
[TD]Borden[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Town[/TD]
[TD]State
[/TD]
[/TR]
[TR]
[TD]Major[/TD]
[TD]Major[/TD]
[TD]Major[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]George[/TD]
[TD]R[/TD]
[TD]Martin[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Town[/TD]
[TD]State[/TD]
[/TR]
[TR]
[TD]Major[/TD]
[TD]Major[/TD]
[TD]Major[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Frank [/TD]
[TD]S[/TD]
[TD]Mint[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Town[/TD]
[TD]State[/TD]
[/TR]
[TR]
[TD]Major[/TD]
[TD]Major[/TD]
[TD]Major[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Louise[/TD]
[TD]L[/TD]
[TD]Peterson[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Town[/TD]
[TD]State[/TD]
[/TR]
[TR]
[TD]Major[/TD]
[TD]Major[/TD]
[TD]Major[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Any help would be greatly appreciated, it's for my university's honors graduation ceremony

 

[reuben9000]

Hey,

You don't need to do this via macros. You can just use an Indirect formula to pull the data into another sheet.

Few callouts before you start:

1. Make sure the name of your original sheet is Sheet1 (where all the data is present)
2. Make sure the new sheet has the name Sheet2
3. Make sure that everything is in the same position as you have described in your question

Process:

Basically go to another sheet and then put values B1 as 1, C1 as 2, D1 as 3 and so on until I.

Then in the first column, in A2, put 1 as the value. THen copy the following formula into cells B2 to I2

INDIRECT("Sheet1!R"&Sheet2!$A2&"C"&Sheet2!B$1,FALSE)

For the next row define A3 as = A2. Then put the following formula from B3 to D3

INDIRECT("Sheet1!R"&Sheet2!$A3&"C"&Sheet2!E$1,FALSE)

You should be able to understand what's going after this point. Just put A4 = A2+1 and then repeat the entire process I've told you above. After that just keep copying entire rows and the formula will keep pulling the relevant values for as many rows as you want.

 

[reuben9000]

Just remember, put the formulae I've told you into column B and then copy and paste the formula into the other cells everytime.

 

[mikerickson]

Assuming that the data starts in A1:H5 and you want the result to be in A1:E10 (i.e. town is in column D), this should do what

Sub test()
    Dim myRange As Range
    Dim i As Long
    With ThisWorkbook.Sheets("sheet1").Range("A:H")
        Set myRange = Range(.Cells(Rows.Count, 1).End(xlUp), .Cells(1, .Columns.Count))
    End With
    
    With myRange
        For i = .Rows.Count To 1 Step -1
            With .Rows(i)
                .Rows(2).Insert shift:=xlDown
                .Cells(2, 1).Resize(1, 3) = .Range("D1:F1").Value
                .Range("D1:E1").Value = .Range("G1:H1").Value
                .Range("F1:H1").ClearContents
            End With
        Next i
    End With
End Sub

I hope that you know that your desired lay-out is almost impossible to work with and that the result formatting is for display only. ie. no further processing/averaging/counting... anything except looking is to be done with the data.

 

[Yuffiek133]

Assuming that the data starts in A1:H5 and you want the result to be in A1:E10 (i.e. town is in column D), this should do what

Sub test()
    Dim myRange As Range
    Dim i As Long
    With ThisWorkbook.Sheets("sheet1").Range("A:H")
        Set myRange = Range(.Cells(Rows.Count, 1).End(xlUp), .Cells(1, .Columns.Count))
    End With
    
    With myRange
        For i = .Rows.Count To 1 Step -1
            With .Rows(i)
                .Rows(2).Insert shift:=xlDown
                .Cells(2, 1).Resize(1, 3) = .Range("D1:F1").Value
                .Range("D1:E1").Value = .Range("G1:H1").Value
                .Range("F1:H1").ClearContents
            End With
        Next i
    End With
End Sub

I hope that you know that your desired lay-out is almost impossible to work with and that the result formatting is for display only. ie. no further processing/averaging/counting... anything except looking is to be done with the data.

....That... was a lot simpler than my code and it did exactly what I wanted it to do... Thank you so much!

 

[mikerickson]

When inserting or deleting rows from a worksheet, working from the bottom up makes things much simpler.