Excel Freezing on Copy/Paste Macro for About 10 Minutes, More Efficient Way to do This?

Question

I'm encountering an issue using excel VBA macros where the execution portion of the code runs in excess of 8-10 minutes sometimes. I've narrowed it down to this part of the code that copies and pastes to another sheet based on the values of cells in a row.

Sub ChangeTest()

    Sheets.Add.Name = "FY16"
    Sheets.Add.Name = "FY17"
    Sheets.Add.Name = "FY18"
    Sheets.Add.Name = "FY19"


'Change worksheet designations as needed
    Set Source = ActiveWorkbook.Worksheets("FY SalesLeads")

    j = 1     ' Start copying to row 1 in target sheet
    k = 1
    l = 1
    m = 1

    For Each c In Source.Range("B1:B8000")   ' Do 1000 rows
        If c = "A" Then
            Set Target = ActiveWorkbook.Worksheets("FY16")
           Source.Rows(c.Row).Copy Target.Rows(j)
           j = j + 1

        ElseIf c = "B" Then

        Set Target = ActiveWorkbook.Worksheets("FY17")
        Source.Rows(c.Row).Copy Target.Rows(k)
           k = k + 1

        ElseIf c = "C" Then

        Set Target = ActiveWorkbook.Worksheets("FY18")
        Source.Rows(c.Row).Copy Target.Rows(l)
           l = l + 1

        ElseIf c = "D" Then

        Set Target = ActiveWorkbook.Worksheets("FY19")
        Source.Rows(c.Row).Copy Target.Rows(m)
           m = m + 1


        End If

    Next c
End Sub

Is there a way to do this more efficiently that doesn't hang up Excel? I've also noticed that after running the Macro sometimes even Windows Explorer becomes unresponsive as well.

Thanks for what everyone does here, I love this community!

Instead of looping, use [AUTOFILTER](https://stackoverflow.com/questions/11631363/how-to-copy-a-line-in-excel-using-a-specific-word-and-pasting-to-another-excel-s/11633207#11633207) to copy in one go? — Siddharth Rout, Aug 21 '18 at 03:48
`Application.ScreenUpdating = False` may speed it up a bit but the autofilter sounds reasonable. — jivko, Aug 21 '18 at 03:54
Is `c` defined else where? I just find it strange that you are doing a for each `c` and then you turn around and check to see if `c` is equal to a string. It sounds to me like `c` is a cell/range and a string at the same time. Did I miss something? — Forward Ed, Aug 21 '18 at 04:25
Siddharth Rout, could you give an example of how it would copy to a new sheet using the autofilter? If it's possible to select all non hidden cells that would probably work best! — Jace2018, Aug 21 '18 at 06:33

GMalc · Answer 1 · 2018-08-22T02:04:58.533

1

As Siddharth Rout pointed out Autofilter will complete your task very quickly. The code adds your new worksheets after the last worksheet. Then it autofilters your data for each criteria and and paste the visible data to A1 on the new worksheet.

Application.ScreenUpdating = False
    Dim ws As Worksheet
    Dim shtArr As Variant
    shtArr = Array("FY16", "FY17", "FY18", "FY19")

    Dim i As Long

    For i = LBound(shtArr) To UBound(shtArr)
        Set ws = Nothing
        On Error Resume Next
        Set ws = Worksheets(shtArr(i))
        On Error GoTo 0
        If ws Is Nothing Then
            Worksheets.Add(After:=Sheets(Sheets.Count)).Name = shtArr(i)
        End If
    Next i

    Dim Source As Worksheet
    Set Source = ThisWorkbook.Worksheets("Sheet1")

    With Source.Range("A1").CurrentRegion
        .AutoFilter
        .AutoFilter Field:=2, Criteria1:="A"
        .Cells.SpecialCells(xlCellTypeVisible).Copy _
            Destination:=Sheets("FY16").Range("A1")

        .AutoFilter Field:=2, Criteria1:="B"
        .Cells.SpecialCells(xlCellTypeVisible).Copy _
            Destination:=Sheets("FY17").Range("A1")

        .AutoFilter Field:=2, Criteria1:="C"
        .Cells.SpecialCells(xlCellTypeVisible).Copy _
            Destination:=Sheets("FY18").Range("A1")

        .AutoFilter Field:=2, Criteria1:="D"
        .Cells.SpecialCells(xlCellTypeVisible).Copy _
            Destination:=Sheets("FY19").Range("A1")
        .AutoFilter
    End With

Application.ScreenUpdating = True

edited Aug 22 '18 at 02:04

answered Aug 21 '18 at 04:44

GMalc

2,608
1
9
16

Thanks, I'll try this out and let you know how it goes. I've never used StackOverflow's formatting before but is there a way to choose best solution or give kudos out? – Jace2018 Aug 21 '18 at 06:35
Accept the answer by clicking the tick below the voting buttons on the left. While in the area, click on the up-vote button too. – Mark Fitzgerald Aug 21 '18 at 08:36
@Jace2018, see Mark Fitzgerald's comment. – GMalc Aug 21 '18 at 12:40
@GMalc, that code does not work, it says the names have already been used and breaks on: `.Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "FY16"` Then it breaks again on the first call to Autofilter, where it says its method of Range class fails: `.AutoFilter` – Jace2018 Aug 21 '18 at 23:34
So did you already create the worksheets while testing. When testing code the creates worksheets, you have to delete the worksheets before running the code again. – GMalc Aug 22 '18 at 01:32
@Jace2018; see my edit, I update the code to check if the worksheet already exist. Please accept the answer by clicking the voting buttons – GMalc Aug 22 '18 at 02:06

Excel Freezing on Copy/Paste Macro for About 10 Minutes, More Efficient Way to do This?

1 Answers1