Clean up code

[BarneyLTD]

Hi guys, bit of a novice at VBA and I have pieced together a workbook combing code I have recorded, sourced on the web and with help from this board. The code seems slow and clunky and I've now started to get 1004 errors.

Is anyone willing to take a look and try and clean up the code for me? i understand this could be a big ask but if anyone has the time and is willing to help, i would very much appreciate it.

 

[Finalfight40]

Hi Barney

So that other people can see what you are working with, it would be best to paste your code. There are A LOT of people on this website who are amazing with VBA that i'm sure will at least take a look.

Also it might help to provide an explanation of what the code is doing and where you are getting the errors.

Use the CODE tags around your code so that it is easy for other people to read and it will look something like this:

insert code here

 

[BarneyLTD]

Thanks Finalfight, I have 9 modules in total that perform various tasks so would be great to get them all checked but right now the code below is where I'm getting an error.

Sub CreateList_CD()'
' CreateList_CD Macro
'


'
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False


    Sheets("CD").Copy
    Columns("E:E").Cut
    Columns("C:C").Insert Shift:=xlToRight ' 1004 error here
    Columns("E:E").Select
    Selection.Delete Shift:=xlToLeft
    Columns("D:D").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("F:F").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("I:I").Select
    Selection.Cut
    Columns("E:E").Select
    Selection.Insert Shift:=xlToRight
    Range("C2:D2").Select
    Range(Selection, Selection.End(xlDown)).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent5
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Order"
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "Order"
    Columns("D:D").EntireColumn.AutoFit
    Columns("G:G").EntireColumn.AutoFit
    
    Range("A1").Select
  
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True




Dim file_name As Variant
Dim FName As String
FName = "CD List"
' Get the file name.
file_name = Application.GetSaveAsFilename(FName, _
FileFilter:="Excel Files,*.xlsx,All Files,*.*", _
Title:="Save As File Name")
' See if the user canceled.
If file_name = False Then Exit Sub
' Save the file with the new name.
If LCase$(Right$(file_name, 4)) <> ".xlsx" Then
file_name = file_name
End If
ActiveWorkbook.SaveAs FileName:=file_name


End Sub

 

[Fluff]

What is the actual error message?

 

[BarneyLTD]

Hi Fluff, it is Runtime Error 1004 Insert method of Range class failed

 

[Fluff]

Is the sheet protected?
Also do you have any merged cells?

 

[BarneyLTD]

no, and no
it was working fine, slow but no errors. i then changed some code to remove exclusions before it copies the sheet, that works fine but since that i get the error. im just going to change that back and see what happens.

i changed this

Dim DeleteValue As String    Dim rng As Range
    Dim calcmode As Long


    'Fill in the value that you want to delete
    'Tip: use DeleteValue = "<>ron" to delete rows without ron
    DeleteValue = "=Y"


    'Sheet with the data, you can also use Sheets("MySheet")
    With ActiveSheet




        'Apply the filter
        .Range("T1:T" & .Rows.Count).AutoFilter Field:=1, Criteria1:=DeleteValue


        With .AutoFilter.Range
            On Error Resume Next
            Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
                      .SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
            If Not rng Is Nothing Then rng.EntireRow.Delete
        End With
        
        'Remove the AutoFilter
        .AutoFilterMode = False


    End With

To this to try and speed it up

' remove exc    If Not ActiveSheet.AutoFilterMode Then
    ActiveSheet.Range("A1").AutoFilter
    End If
    ActiveWorkbook.Worksheets("CD").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("CD").AutoFilter.Sort.SortFields.Add2 Key:=Range( _
        "$T$1:$T$1048576"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("CD").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveSheet.Range("$A$1:$T$1048576").AutoFilter Field:=20, Criteria1:="Y"
    Range("$A$2:$T$1048576").SpecialCells(xlCellTypeVisible).ClearContents
    ActiveSheet.Range("$A$1:$T$148473").AutoFilter Field:=20
    If ActiveSheet.AutoFilterMode Then
    ActiveSheet.AutoFilterMode = False
    End If

 

[Fluff]

There's nothing in those codes that would prevent inserting a column.
If you goto the CD sheet & press Ctrl + End, what cell does it take you to?

 

[BarneyLTD]

CTRL+END takes me to I1048576

 

[Fluff]

Whilst shouldn't prevent your code from working, it will seriously slow down any code you have.

Delete all rows below your last row of data, save the file & use Ctrl + end again. Where does that take you?