Macro is Adding extra columns

spyldbrat

Board Regular
Joined
May 5, 2002
Messages
211
Office Version
  1. 365
Hello, I recorded a macro. For some reason, it is copying columns F to M (starting at row 6) and pasting it in columns N to AC (t pastes all 9 columns 3 times). Since this macro is primarily just formatting, I am able to read most of the macro coding. I am not able to see anywhere within this macro where it is saying to copy and paste F to M to any columns! Can you tell me why this is happening and how to fix it? I apologize but the macro is pretty long....

Sub Format_Comp3()
'
' Format_Comp3 Macro
'

'
Sheets(Array("NY Reg", "NY Lic & Reg", """Skip"" in Ramco", "Annual", "90 Day", "Support", "NY Term", "PA Stmt #", _
"PA Print Card Corp", "PA Print Card State", "PA Emp Ver", "PA Child Abuse", "NJN", "NJS", "Shannon")).Select
Sheets("NY Reg").Activate
Columns("A:G").Select
Columns("A:G").EntireColumn.AutoFit
Columns("A:G").EntireColumn.AutoFit
Columns("A:G").EntireColumn.AutoFit
Columns("B:B").Select
Selection.ColumnWidth = 21.14
Columns("A:A").ColumnWidth = 12.43
Columns("B:B").EntireColumn.AutoFit
Columns("E:E").ColumnWidth = 14
Range("F1:F6").Select
Selection.ClearContents
Range("B1:B5").Select
Selection.ClearContents
Rows("7:7").Select
Selection.Font.Bold = True
Range("A6").Select
ActiveCell.FormulaR1C1 = "Respond to Yellow"
Range("a6:m6").Select
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
With Selection.Font
.Name = "Calibri"
.Size = 28
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.Color = -16776961
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Range("B6").Select
Selection.ClearContents
Range("C6:G6").Select
Selection.ClearContents
Columns("F:M").Select
Selection.Insert Shift:=xlToRight
Range("F7").Select
ActiveCell.FormulaR1C1 = "Status"
Range("G7").Select
ActiveCell.FormulaR1C1 = "On Dataset"
Range("H7").Select
ActiveCell.FormulaR1C1 = "Prior Notes"
Range("I7").Select
ActiveCell.FormulaR1C1 = "7/6: Shannon"
Range("J7").Select
ActiveCell.FormulaR1C1 = "7/6: Audit Comments - NY"
Range("K7").Select
ActiveCell.FormulaR1C1 = "Do Not Write in This Column"
Range("L7").Select
ActiveCell.FormulaR1C1 = "Dataset Lookup"
Range("M7").Select
ActiveCell.FormulaR1C1 = "Date Value"
Range("F8").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-5],EEMstr,2,FALSE)"
Range("G8").Select
Windows("Master Spreadsheet1.xlsm").Activate
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[5],Dataset,7,FALSE)"
Columns("H:J").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.ColumnWidth = 43.71
ActiveWindow.Zoom = 90
ActiveWindow.Zoom = 80
ActiveWindow.Zoom = 70
ActiveWindow.Zoom = 80
Range("K7:K8").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("L8").Select
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
ActiveCell.FormulaR1C1 = "=CONCAT(RC[-11],"" "",RC[-9])"
Range("M8").Select
ActiveCell.FormulaR1C1 = "=DATEVALUE(RC[-9])"
Range("M9").Select
ActiveWindow.SmallScroll ToRight:=-1
Range("A6:K6").Select
With Selection
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.Font.Bold = True
Columns("D:D").EntireColumn.AutoFit
ActiveWindow.Zoom = 90
Range("A7:M7").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Columns("B:B").ColumnWidth = 21.86
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("G:G").ColumnWidth = 10.14
Columns("F:F").ColumnWidth = 9.86
Sheets(Array("PA Stmt #", "PA Print Card Corp", "PA Print Card State", "PA Emp Ver", "PA Child Abuse", "NJS")).Select
Sheets("PA Stmt #").Activate
Range("J7").Select
ActiveCell.FormulaR1C1 = "7/6: Audit Comments - PA"
Range("J8").Select

End Sub
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
One thing you can to to see where it is duplicating the data is to hit F8 on your code. It will scroll through the code one line at a time, instead of running through the entire code. This way you can find what line(s) are creating the problem and then you can remove or modify them accordingly.
 
Upvote 0
Do you have any worksheet, or workbook events?
 
Upvote 0

Forum statistics

Threads
1,214,644
Messages
6,120,709
Members
448,983
Latest member
Joaquim_Baptista

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