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:
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