Macro Help: Replacement for cut and delete Speed wise

[BBallerl]

I’m looking for a way around using the commands

.delete

.cut

In my excel macros. I’m finding that these processes greatly slow down the procedure (by up to 20 min) for the more data it has to cut paste and delete. Also these processes seem to deactivate my status bar updates from the macro.


I use these commands to move a row (1st column to 374th column) of data into a different worksheet if it meets a certain criteria.


Here is the macro process I use with these commands:
The main lines of concern I have is with 350, 353 and 357

[vba] 328 j = 0
329 FinalRowMF = Worksheets("Main Frame").Cells(Rows.Count, 8).End(xlUp).Row
330 FinalRowAr = Worksheets("Archive").Cells(Rows.Count, 8).End(xlUp).Row

331 For k = 7 To FinalRowMF
332 Application.StatusBar = "Ignore = " & Ignore & " Current File " & ImportDate - FirstDateImport + 1 & " of " & LastDateImport - FirstDateImport + 1 & " = " & fileName & " Loop k = " & k - 6 & " of " & FinalRowMF - 6
333 If Worksheets("Main Frame").Cells(k, 6).Value = "" Then
334 j = j + 1
335 End If
336 Next k
337 Worksheets("Archive").Activate
338 If j = 0 Then
339 Worksheets("Archive").Range(Cells(7, 9 + DaysOffset), Cells(FinalRowAr, 9 + DaysOffset)).Interior.ThemeColor = xlThemeColorAccent4
GoTo NoInactives:
340 End If
341 ActiveWindow.ScrollColumn = DaysOffset
342 Worksheets("Archive").ListObjects("Table24").Resize Range("$F$6:NJ" & FinalRowAr + j)
343 With Worksheets("Archive").Range("$I$" & FinalRowAr + 1 & ":NJ" & FinalRowAr + j).Interior
344 .Pattern = xlNone
345 .TintAndShade = 0
346 .PatternTintAndShade = 0
347 End With

348 m = j
349 For n = 7 To FinalRowMF - j
350 Application.StatusBar = "Ignore = " & Ignore & " Current File " & ImportDate - FirstDateImport + 1 & " of " & LastDateImport - FirstDateImport + 1 & " = " & fileName & " Finding and Moving ID " & j - m + 1 & " of " & j & " Loop n = " & n - 6 & " of " & FinalRowMF - 6
351 If Worksheets("Main Frame").Cells(n, 6).Value = "" Then
352 FinalRowAr = Worksheets("Archive").Cells(Rows.Count, 8).End(xlUp).Row
353 Worksheets("Main Frame").Rows(n).Cut Destination:=Worksheets("Archive").Range(Cells(FinalRowAr + 1 - m, 1), Cells(FinalRowAr + 1 - m, 374))
354 Worksheets("Archive").Range(Cells(FinalRowAr + 1 - m, 1), Cells(FinalRowAr + 1 - m, 374)).Borders(xlEdgeTop).LineStyle = xlNone
355 Worksheets("Archive").Cells(FinalRowAr + 1 - m, 8).Borders(xlEdgeTop).ThemeColor = 1
356 Worksheets("Archive").Cells(FinalRowAr + 1 - m, 8).Borders(xlEdgeTop).TintAndShade = -0.249977111117893
357 Worksheets("Main Frame").Rows(n).Delete Shift:=xlUp
358 If m = 0 Then
359 Else
360 n = n - 1
361 m = m - 1
362 End If
363 End If
If m = 0 Then GoTo LastReplaced:
364 Next n

LastReplaced:

365 Application.StatusBar = "Ignore = " & Ignore & " Current File " & ImportDate - FirstDateImport + 1 & " of " & LastDateImport - FirstDateImport + 1 & " = " & fileName & " Loop k Counter Result j = " & j
366 Worksheets("Archive").Range(Cells(7, 9 + DaysOffset + 1), Cells(FinalRowAr, 9 + DaysOffset + 1)).Interior.ThemeColor = xlThemeColorAccent4
367 ArDateChange = ImportDate - 1
368 ArSort = True
GoTo SetMonth:

ArSort:

369 With ActiveWorkbook.Worksheets("Archive").ListObjects("Table24").Sort
370 .SortFields.Clear
371 .SortFields.Add(Range("Table24[[#All],[" & DayValue & " - " & MonthName & "]]"), xlSortOnCellColor, xlAscending, xlSortNormal).SortOnValue.ColorIndex = xlNone
372 .Header = xlYes
373 .MatchCase = False
374 .Orientation = xlTopToBottom
375 .SortMethod = xlPinYin
376 .Apply
377 .SortFields.Clear
378 .SortFields.Add(Range("Table24[[#All],[" & DayValue & " - " & MonthName & "]]"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = 65535
379 .Header = xlYes
380 .MatchCase = False
381 .Orientation = xlTopToBottom
382 .SortMethod = xlPinYin
383 .SortFields.Clear
384 .SortFields.Add(Range("Table24[[#All],[" & DayValue & " - " & MonthName & "]]"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = 49407
385 .Header = xlYes
386 .MatchCase = False
387 .Orientation = xlTopToBottom
388 .SortMethod = xlPinYin
389 .Apply
390 .SortFields.Clear
391 .SortFields.Add(Range("Table24[[#All],[" & DayValue & " - " & MonthName & "]]"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = 230
392 .Header = xlYes
393 .MatchCase = False
394 .Orientation = xlTopToBottom
395 .SortMethod = xlPinYin
396 .Apply
397 .SortFields.Clear
398 .SortFields.Add(Range("Table24[[#All],[" & DayValue & " - " & MonthName & "]]"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = 16711935
399 .Header = xlYes
400 .MatchCase = False
401 .Orientation = xlTopToBottom
402 .SortMethod = xlPinYin
403 .Apply
404 .SortFields.Clear
405 End With

NoInactives:[/vba]
PS If someone also knows how to shorten the sorting that would be great to.

[Paul_Hossler]

I didn't look that closely, but I couldn't understand why there are 5 sorts on what seems to be the same thing. Wouldn't just the last Sort be sufficient?

2. For deleting rows, I've found that starting from the bottom and deleting my way to the top is much faster.

3. Is Application.ScreenUpdating = False?

Paul

[BBallerl]

I sort one column by several different colours. Can delete the extra stuff other than the sorts?

All these sections:
[vba].Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.SortFields.Clear
[/vba]
For #2 I'll give it a try but the deletion process itself is still very slow and seems to get slower the longer the macro runs

For #3 Yes It is false, but the status bar should still update. It's odd because the cut and delete loop section is the only part it seems not to work