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: 21
  • Example Before.JPG
    Example Before.JPG
    142.5 KB · Views: 21

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
You must log in or register to reply here.

Similar threads

J
  • Question Question
VBA removing heading in spreadsheet
Replies
3
Views
273
rlv01
R
S
  • Question Question
Macro Formatting to all WS
Replies
4
Views
360
MARK858
MARK858
J
  • Question Question
VBA or formula to move data in last used column to column A
Replies
5
Views
228
Peter_SSs
Peter_SSs
C
  • Question Question
How to get my macro to stop at the last recognized line
Replies
6
Views
555
Coco1
C
R
  • Question Question
Excel VBA IF statement
Replies
4
Views
238
DanteAmor
DanteAmor

Forum statistics

Threads
1,224,823
Messages
6,181,183
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

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