0

I need a message displayed in the status bar. I have written the below code. It is freezing Excel after displaying up to 300+.

The main sheet has 20K+ data and copying is taking around 10 minutes.

It will be good if the status bar can show it.

I thought of using a Progress Bar, but it will also freeze.

Sub Split_Consolidate_Data()
    Call Delet_Split_Consolidated_Old_Date
    Dim xRange1 As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long

    I = ActiveWorkbook.Worksheets("Consolidated Data").UsedRange.rows.Count
    Set xRange1 = ActiveWorkbook.Worksheets("Consolidated Data").Range("AA2:AA" & I)
    J = 1
    L = 1
    M = 1
    n = 1
    O = 1
    P = 1
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRange1.Count
        Application.StatusBar = "Copying " & K & ""
        If (CStr(xRange1(K).Value) = 1) Then
            xRange1(K).EntireRow.Copy Destination:=Worksheets("Week 1").Range("A" & J + 1)
            J = J + 1
        ElseIf (CStr(xRange1(K).Value) = 2) Then
            xRange1(K).EntireRow.Copy Destination:=Worksheets("Week 2").Range("A" & L + 1)
            L = L + 1
        ElseIf (CStr(xRange1(K).Value) = 3) Then
            xRange1(K).EntireRow.Copy Destination:=Worksheets("Week 3").Range("A" & M + 1)
            M = M + 1
        ElseIf (CStr(xRange1(K).Value) = 4) Then
            xRange1(K).EntireRow.Copy Destination:=Worksheets("Week 4").Range("A" & n + 1)
            n = n + 1
        ElseIf (CStr(xRange1(K).Value) = 5) Then
            xRange1(K).EntireRow.Copy Destination:=Worksheets("Week 5").Range("A" & O + 1)
            O = O + 1
        ElseIf (CStr(xRange1(K).Value) = 6) Then
            xRange1(K).EntireRow.Copy Destination:=Worksheets("Week 6").Range("A" & P + 1)
            P = P + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub

How can I get rid of the freeze or is there any other way I can see how much has processed?

Community
  • 1
  • 1
Maitreya
  • 69
  • 1
  • 2
  • 8
  • 2
    After `Application.StatusBar = "Copying " & K & ""` add one more line `DoEvents` – Siddharth Rout Dec 19 '19 at 12:46
  • 1
    @SiddharthRout, wouldn't it be delaying the macro even more? I would say the statusbar simply can't keep up. If you want to have anything like that without too much more delay, maybe do a `DoEvents` in an interval, e.g.: every 1000 records. Btw, I haven't checked the macro itself if some runtime can be won. – JvdV Dec 19 '19 at 12:48
  • 1
    @JvdV: Yes it will delay but will not freeze the status bar. One can use `MOD` or alternate methods to calculate and show message after every 5% – Siddharth Rout Dec 19 '19 at 12:50
  • 1
    That's more in line with what I was thinking =) @SiddharthRout. To OP: I see a lot of Copy/Pasting, which weigh heavy on your runtime. This can be avoided through simple `.Value` transfers, possibly even through memory if you want to cut down your runtime. – JvdV Dec 19 '19 at 12:52
  • I have a feeling that the code can be made a lot faster by using Autofilter to copy the rows across... [HERE](https://stackoverflow.com/questions/11631363/how-to-copy-a-line-in-excel-using-a-specific-word-and-pasting-to-another-excel-s) is an example – Siddharth Rout Dec 19 '19 at 12:54
  • DoEvent Seems to solve it, though it is delaying. I do not have issue with autofilter, but i will try that sometime else. Thanks @SiddharthRout – Maitreya Dec 19 '19 at 12:55
  • oh yes it will solve it but you may want to think about what I mentioned in my last comment? – Siddharth Rout Dec 19 '19 at 12:56
  • 1
    Also you are converting to string and checking numerics. J to P variables can just be counitfs, as @SiddharthRout said filtering may be a good alternative too. – Nathan_Sav Dec 19 '19 at 12:56

0 Answers0