Need Excel VBA to move multiple rows into 1 row

cmschmitz24

cmschmitz24

Board Regular
Joined
Jan 27, 2017
Messages
150
I need help writing a macro that will merge rows into one row based on multiple criteria. I apologize, I don't quite know how to explain it best, but basically the corresponding "plan typ" data needs to be moved into the correct "Plan Type" column based on the specific number if the rows are for all the same data in column A. Once all the data is into one row, then the remaining rows can be deleted. Data is variable and column A can have 1-x number or rows.

I have attached before and after examples. But because of how big these reports are, the example pictures aren't all encompassing.

Thank you for your help!

Here's the current formatting code that's been created:

VBA Code: 
Sub AMYC()
'
' AMYC Macro
'

'
    Cells.Select
    Range("A2").Activate
    Cells.EntireColumn.AutoFit
    Range("A2").Select
    Columns("A:A").EntireColumn.AutoFit
    Columns("A:A").ColumnWidth = 8.22
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "Empl RCD"
    Range("B3").Select
    Columns("B:B").EntireColumn.AutoFit
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "Campus"
    Range("N2").Select
    ActiveCell.FormulaR1C1 = "Plan Typ 10"
    Columns("Q:Q").Select
    Range("Q2").Activate
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Range("Q2").Select
    ActiveCell.FormulaR1C1 = "Plan Typ 11"
    Range("R2").Select
    ActiveCell.FormulaR1C1 = "Plan"
    Range("S2").Select
    ActiveCell.FormulaR1C1 = "Covg Cd"
    Columns("T:T").Select
    Range("T2").Activate
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Range("T2").Select
    ActiveCell.FormulaR1C1 = "Plan Typ 14"
    Range("U2").Select
    ActiveCell.FormulaR1C1 = "Plan"
    Range("V2").Select
    ActiveCell.FormulaR1C1 = "Covg Cd"
    Columns("W:W").Select
    Range("W2").Activate
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Range("W2").Select
    ActiveCell.FormulaR1C1 = "Plan Typ 1D"
    Range("X2").Select
    ActiveCell.FormulaR1C1 = "Plan"
    Range("Y2").Select
    ActiveCell.FormulaR1C1 = "Covg Cd"
    Columns("N:Y").Select
    Range("Y2").Activate
    Columns("N:Y").EntireColumn.AutoFit
    Range("N2:Y2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    Columns("AA:AA").Select
    Range("AA2").Activate
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Range("AA2").Select
    ActiveCell.FormulaR1C1 = "Plan Typ 2A"
    Range("AB2").Select
    ActiveCell.FormulaR1C1 = "Plan"
    Range("AC2").Select
    ActiveCell.FormulaR1C1 = "Plan Typ 2M"
    Columns("AE:AE").Select
    Range("AE2").Activate
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Range("AC2:AD2").Select
    Selection.Copy
    Range("AE2").Select
    ActiveSheet.Paste
    Range("AG2").Select
    ActiveSheet.Paste
    Range("AI2").Select
    ActiveSheet.Paste
    Range("AK2").Select
    ActiveSheet.Paste
    Range("AM2").Select
    ActiveSheet.Paste
    Range("AO2").Select
    ActiveSheet.Paste
    Range("AQ2").Select
    ActiveSheet.Paste
    Range("AS2").Select
    ActiveSheet.Paste
    Range("AU2").Select
    ActiveSheet.Paste
    Range("AE2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "Plan Typ 2N"
    Range("AG2").Select
    ActiveCell.FormulaR1C1 = "Plan Typ 2O"
    Range("AI2").Select
    ActiveCell.FormulaR1C1 = "Plan Typ 2P"
    Range("AK2").Select
    ActiveCell.FormulaR1C1 = "Plan Typ 2Q"
    Range("AM2").Select
    ActiveCell.FormulaR1C1 = "Plan Typ 2R"
    Range("AO2").Select
    ActiveCell.FormulaR1C1 = "Plan Typ 2S"
    Range("AQ2").Select
    ActiveCell.FormulaR1C1 = "Plan Typ 2T"
    Range("AS2").Select
    ActiveCell.FormulaR1C1 = "Plan Typ 2U"
    Range("AU2").Select
    ActiveCell.FormulaR1C1 = "Plan Typ 2M="
    ActiveCell.FormulaR1C1 = "Plan Typ 2V"
    Columns("AA:AV").Select
    Range("AV2").Activate
    Columns("AA:AV").EntireColumn.AutoFit
    Range("AA2:AU2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    Range("AU2").Select
    Columns("AX:AX").Select
    Range("AX2").Activate
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Range("AZ2:BA2").Select
    Selection.Copy
    Range("AX2").Select
    ActiveSheet.Paste
    Range("AX2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "Plan Typ 3Y"
    Range("AZ2").Select
    ActiveCell.FormulaR1C1 = "Plan Typ 3Z"
    Columns("AX:BA").Select
    Range("AX2").Activate
    Columns("AX:BA").EntireColumn.AutoFit
    Range("AX2:BA2").Select
    Range("BA2").Activate
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    Columns("BC:BC").Select
    Range("BC2").Activate
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Range("BK2:BL2").Select
    Range("BL2").Activate
    Selection.Copy
    Range("BC2").Select
    ActiveSheet.Paste
    Range("BE2").Select
    ActiveSheet.Paste
    Range("BG2").Select
    ActiveSheet.Paste
    Range("BI2").Select
    ActiveSheet.Paste
    Range("BC2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "Plan Typ 4S"
    Range("BE2").Select
    ActiveCell.FormulaR1C1 = "Plan Typ 4T"
    Range("BG2").Select
    ActiveCell.FormulaR1C1 = "Plan Typ 4Z"
    Columns("BI:BJ").Select
    Range("BI2").Activate
    Selection.Delete Shift:=xlToLeft
    Range("BI2").Select
    ActiveCell.FormulaR1C1 = "Plan Typ 4Y"
    Columns("BC:BJ").Select
    Range("BJ2").Activate
    Columns("BC:BJ").EntireColumn.AutoFit
    Range("BC2:BJ2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent4
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    Columns("BE:BE").Select
    Range("BE2").Activate
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Columns("BI:BI").Select
    Range("BI2").Activate
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Columns("BM:BM").Select
    Range("BM2").Activate
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Range("BQ2:BR2").Select
    Selection.Copy
    Range("BM2").Select
    ActiveSheet.Paste
    Range("BI2").Select
    ActiveSheet.Paste
    Range("BE2").Select
    ActiveSheet.Paste
    Range("BE2:BF2,BI2:BJ2,BM2:BN2").Select
    Range("BM2").Activate
    Application.CutCopyMode = False
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent4
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    Columns("BC:BP").Select
    Range("BP2").Activate
    Columns("BC:BP").EntireColumn.AutoFit
    Range("BP2").Select
    Columns("BO:BO").Select
    Range("BO2").Activate
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Columns("BG:BG").Select
    Range("BG2").Activate
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Columns("BM:BM").Select
    Range("BM2").Activate
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Range("BY2:BZ2").Select
    Selection.Copy
    Range("BS2").Select
    ActiveSheet.Paste
    Range("BM2").Select
    ActiveSheet.Paste
    Range("BG2").Select
    ActiveSheet.Paste
    Range("BG2:BH2,BM2:BN2,BS2:BT2").Select
    Range("BS2").Activate
    Application.CutCopyMode = False
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent4
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    Range("BW2:BZ2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent4
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    Columns("CE:CE").Select
    Range("CE2").Activate
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Range("CK2:CM2").Select
    Selection.Copy
    Range("CE2").Select
    ActiveSheet.Paste
    Range("CH2").Select
    ActiveSheet.Paste
    Range("CE2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "Plan Typ 60"
    Range("CG2").Select
    ActiveCell.FormulaR1C1 = "Annl Pledg 61"
    Range("CH2").Select
    ActiveCell.FormulaR1C1 = "Plan Typ 61"
    Range("CG2").Select
    ActiveCell.FormulaR1C1 = "Annl Pledg"
    Range("CK2").Select
    ActiveCell.FormulaR1C1 = "Plan Typ 67"
    Columns("CE:CM").Select
    Range("CM2").Activate
    Columns("CE:CM").EntireColumn.AutoFit
    Range("CE2:CM2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    Columns("CO:CO").Select
    Range("CO2").Activate
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Range("CQ2:CR2").Select
    Selection.Copy
    Range("CO2").Select
    ActiveSheet.Paste
    Range("CO2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "Plan Typ 7W"
    Range("CQ2").Select
    ActiveCell.FormulaR1C1 = "Plan Typ 7Y"
    Columns("CO:CR").Select
    Range("CO2").Activate
    Columns("CO:CR").EntireColumn.AutoFit
    Range("CO2:CR2").Select
    Range("CR2").Activate
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With

End Sub
 

Attachments

  • Example After.JPG
    Example After.JPG
    68.2 KB · Views: 19
  • Example Before.JPG
    Example Before.JPG
    142.5 KB · Views: 19

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
You must log in or register to reply here.

Similar threads

C
  • Question
How to get my macro to stop at the last recognized line
Replies
6
Views
208
Coco1
C
P
  • Question
Help with Vba Code
Replies
3
Views
160
Coyotex3
C
G
  • Question
How can i extract the correct leave time on this code?
Replies
1
Views
362
rlv01
R
D
  • Solved
Run-time error 9, Subscript out of range - Copying sheet from closed workbook to active workbook as new sheet
Replies
9
Views
298
dvward
D
C
  • Solved
How to not set a range in VBA
Replies
7
Views
389
Coco1
C

Forum statistics

Threads
1,214,975
Messages
6,122,538
Members
449,088
Latest member
RandomExceller01

Share this page

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