VBA slowing a sheet?

[stevod]

Hi,

I've made a sheet, macro enabled and have a few macros that run some code. Its a blank sheet, data gets pasted in press a button and the code runs (i'm just being very simple here). There's not a lot of data, columns C:AZ and random in length, the sheets it comes from are like 20kb.

The issue i'm having is when i paste the data in and run the code, this works fine. It deletes columns, cuts and moves them. Finds changes in a specific column and inserts borders for each change and a few more things. Nothing too taxing.

I have a reset code and this is where it slows down, it literally selects the columns
Columns("C:AZ").Select
Selection.Delete Shift:=xlToLeft
Range("C1").Select

Then when i paste different data it takes a good 10 to 15 seconds, then to run the macro it will have a grey screen and takes 3 or 4 times as long to do it.
my only fix is to close it, reopen and it works fine... once

Anyone encountered this before? And is there a simple solution?

Thanks for looking, Steve

 

[My Aswer Is This]

Show us all the entire scripts your attempting to run.
You only showed us one part.

 

[stevod]

Sub Wolf_Data()

' Macro3 Macro
    Application.ScreenUpdating = False
    Application.CutCopyMode = False
'delete columns not required and move colums around
    Range("AF:AI, AD:AD, X:Y, V:V, Q:Q, L:L, J:J, D:H").Delete
    Columns("D:D").Select
    Selection.Cut
    Columns("F:F").Select
    Selection.Insert Shift:=xlToRight
    Columns("F:F").Select
    Selection.Cut
    Columns("H:H").Select
    Selection.Insert Shift:=xlToRight
    Columns("D:D").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromRightOrBelow
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromRightOrBelow
        Range("C2").Value = "ASOS"
        Range("U:U").Select
'change number format for MDA Number
    With Selection
    Selection.NumberFormat = "00000000000000"
    .Value = .Value
    End With
' reset_sheet
    Range("C1:Y1000").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Application.ScreenUpdating = True

Call Copytolastrow

End Sub

Sub Copytolastrow()

    Dim Last_Row As Long
    Application.CutCopyMode = False
    Last_Row = Range("D" & Rows.Count).End(xlUp).Row
    Range("C2").Copy Range("C3:C" & Last_Row)
    
Call Copytolastrow_mg

End Sub
Sub Copytolastrow_mg()
    Application.ScreenUpdating = False
    Application.CutCopyMode = False

    Dim Last_Row As Long
    Last_Row = Range("D" & Rows.Count).End(xlUp).Row
    Range("E2") = "=VLOOKUP(F2,MG!C:D,2,0)"
    Range("E2").Copy Range("E3:E" & Last_Row)
    Columns("E:E").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("F:F").Delete
      
    Application.ScreenUpdating = True


Call AddBorderLineWhenValueChanges_Style

End Sub
Sub AddBorderLineWhenValueChanges_Style()
'add border to Style
    Application.ScreenUpdating = False
    Application.CutCopyMode = False

    Dim LastRow As Long
    Dim xrg As Range
    ''''taken out as both lines are not required''''
    'LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    'For Each xrg In Range("R1:R" & LastRow)
    '    If xrg <> xrg.Offset(1, 0) Then
    '        Range("C" & xrg.Row & ":Y" & xrg.Row).Borders(xlEdgeBottom).LineStyle = xlContinuous
    '    End If
    'Next xrg
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For Each xrg In Range("R1:R" & LastRow)
        If xrg <> xrg.Offset(1, 0) Then
            Range("C" & xrg.Row & ":W" & xrg.Row).Borders(xlEdgeBottom).Weight = xlMedium
        End If
    Next xrg
    Application.ScreenUpdating = True

    
Call Delete_Department_Duplicate

End Sub

Sub Delete_Department_Duplicate()
Dim i As Long
'deletes all repeating department names
Application.ScreenUpdating = False
    For i = Cells(Rows.Count, 15).End(xlUp).Row To 2 Step -1
        If Cells(i - 1, 15).Value = Cells(i, 15).Value Then Cells(i, 15).Offset(, -10).ClearContents
    Next i
Application.ScreenUpdating = True

Call Delete_Call_off_Duplicate
End Sub

Sub Delete_Call_off_Duplicate()
Dim i As Long
Application.ScreenUpdating = False
'deletes all repeating call off id
    For i = Cells(Rows.Count, 15).End(xlUp).Row To 2 Step -1
        If Cells(i - 1, 15).Value = Cells(i, 15).Value Then Cells(i, 15).Offset(, -11).ClearContents
    Next i
    
    Call Addheader
Application.ScreenUpdating = True
End Sub

Sub Select_Data()

    Dim Last_Row As Long
    Application.CutCopyMode = False
    Last_Row = Range("C" & Rows.Count).End(xlUp).Row
    Range("C2:X2" & Last_Row).Select

End Sub

Sub Copy_Data()
      Range("C2:X2", Range("C1").End(xlDown)).Select
      With Selection.Copy
      End With
    
End Sub
  
Sub Addheader()

    Range("C1").Value = "Partner"
    Range("E1").Value = "Department"
    Range("N1").Value = "Sets"
    Range("U1").Value = "MDA"
    Range("V1").Value = "TRAILER"
    Range("W1").Value = "LOAD"
    
    
End Sub

 

[AlphaFrog]

Replace this...

Columns("C:AZ").Select
Selection.Delete Shift:=xlToLeft
Range("C1").Select

With this...

Columns("C:AZ").Clear

 

[My Aswer Is This]

Here is how you should do first part:

Sub Delete_Columns()
'Modified  1/31/2020  11:26:47 PM  EST
Columns("C:AZ").Delete Shift:=xlToLeft
Range("C1").Select
End Sub

 

[My Aswer Is This]

Well after reading all this code I need to just ask.
What is your ultimate Goal here and maybe we can provide code that may work faster for you.

This is way too much code for me to be able to read any understand.

 

[stevod]

The end result of the code works perfectly, its how it slows the sheet down after thats my issue. i dont understand how when i clear the page to paste more data in to run the code on theres a delay, as if the clipboard is full... but the code clears that too

 

[My Aswer Is This]

I have no answer for you sorry.
I notice your code is doing a lot of selecting and normally that is not needed and may slow down your script.
You see the portion of script I used did not use any selecting

 

[Michael M]

Probably need to remove ALL Select.Selection references
for example

Columns("D:D").Cut
    Columns("F:F").Insert

AND

With Range("U:U")'try to reduce the range to a number, rather the entire column
    .NumberFormat = "00000000000000"
    .Value = .Value
    End With
' reset_sheet
    With Range("C1:Y1000").Borders
    .LineStyle = xlNone
End With

AND

Sub Copytolastrow_mg()
    Application.ScreenUpdating = False
    Application.CutCopyMode = False

    Dim Last_Row As Long
    Last_Row = Range("D" & Rows.Count).End(xlUp).Row
    With Range("E2:E" & LastRow)
    .Formula = "=VLOOKUP(F2,MG!C:D,2,0)"
    .Value = .Value
    End With
    Range("F:F").Delete
    Application.ScreenUpdating = True
Call AddBorderLineWhenValueChanges_Style

End Sub

to name just a few !!!

 

[stevod]

Probably need to remove ALL Select.Selection references
for example

Columns("D:D").Cut
    Columns("F:F").Insert

AND

With Range("U:U")'try to reduce the range to a number, rather the entire column
    .NumberFormat = "00000000000000"
    .Value = .Value
    End With
' reset_sheet
    With Range("C1:Y1000").Borders
    .LineStyle = xlNone
End With

AND

Sub Copytolastrow_mg()
    Application.ScreenUpdating = False
    Application.CutCopyMode = False

    Dim Last_Row As Long
    Last_Row = Range("D" & Rows.Count).End(xlUp).Row
    With Range("E2:E" & LastRow)
    .Formula = "=VLOOKUP(F2,MG!C:D,2,0)"
    .Value = .Value
    End With
    Range("F:F").Delete
    Application.ScreenUpdating = True
Call AddBorderLineWhenValueChanges_Style

End Sub

to name just a few !!!

Thanks for your reply, the range is random in length hence why i put a number in there rather than allowing the VBA to define it by a last_row

My bugbear is that when i first paste the data and run the code its fine, works great. Then when i reset it and paste again its slow, then running the code is slow... the more times i run it the slower it gets. but close the workbook and its fine again!?!?

Slightly annoying, the only thing i can think of is the formatting? borders and number formats would this have the slow effect as when the data is pasted again its changing the format too??