2
\$\begingroup\$

I currently have a sorting script that will check line by line for a certain string. If the string matches, then that line will be copied to that worksheet and the line will be deleted. However, sometimes I need to sort tens of thousands of rows and it can take a long time or will crash Excel. Is there a way to rewrite it to be able to sort more efficiently?

In my code, I have the With ws2 block copied multiple times with different sheet names

Dim ws1 As Worksheet, ws2 As Worksheet
Dim firstRowWs1 As Long
Dim lastRowWs1 As Long
Dim lastRowWs2 As Long
Dim searchColumnWs1 As Integer
Dim i As Integer
Dim check As Variant
Dim strSearch As Variant
Dim foundMatches As Boolean
Dim sDate As String
sDate = Format(Now(), "mm/dd/yyyy")
Set ws1 = Worksheets("Sort")
Set ws3 = Worksheets("Overview")


Set ws2 = Worksheets("sheet2")
With ws2
lastRowWs1 = ws1.UsedRange.Rows.Count
lastRowWs2 = ws2.UsedRange.Rows.Count
firstRowWs1 = 1
searchColumnWs1 = 10
strSearch = Array("john")

For i = firstRowWs1 To lastRowWs1
    For Each check In strSearch
        If check = ws1.Cells(i, searchColumnWs1).Value Then
            ws1.Rows(i).Copy (ws2.Rows(lastRowWs2 + 1))
            ws2.Rows(lastRowWs2 + 1).Columns("A:B").Insert xlToRight
            lastRowWs2 = lastRowWs2 + 1
            ws1.Rows(i).Delete shift:=xlUp
            i = i - 1
            Exit For
        End If
    Next check
Next i
End With
\$\endgroup\$
  • \$\begingroup\$ Plenty of good examples on the web for this kind of thing. I found this method to be really fast when deleting particular rows. You'd just need to change the code to copy rather than delete. \$\endgroup\$ – CallumDA Nov 28 '17 at 15:15
  • \$\begingroup\$ To clarify, in the above code you want to copy rows with "John" in column J to next empty row in ws2 and then delete the copied rows from ws1? \$\endgroup\$ – Mark Fitzgerald Nov 29 '17 at 9:14
  • \$\begingroup\$ @MarkFitzgerald correct \$\endgroup\$ – ac1243 Nov 29 '17 at 14:50
1
\$\begingroup\$

Some of your declared variables aren't used in your posted code - ws3, foundMatches, sDate. Maybe they are used in code that you haven't included. Even if you think your code may be too long to post in full, it would be helpful for us to be able to see everything between Sub and End Sub.

Your With ws2 End With is ineffective in so far as you continue to use ws2 explicitly in your code. For example, lastRowWs2 = ws2.UsedRange.Rows.Count should be lastRowWs2 = .UsedRange.Rows.Count.

I'm not sure why you are looping through a single element array strSearch. In fact, you could do away with strSearch and check by simply testing If ws1.Cells(i, searchColumnWs1).Value = "john" Then.

Looping through cells is inefficient. So is copying entire rows. I'm assuming that you actually want to paste into column C of lastRowWs2 + 1 which is why you insert new columns A:B.

While I haven't time tested filtering column J = "john" and copying/pasting the resulting list into .Cells(lasrRowWs2 + 1, 3) I'm confident that it would be much faster.

Avoid declaring variables as Variant because they have an overhead in terms of size and time taken for VBA to work out what sub-type they are.

.UsedRange.Rows.Count can return unexpected results if the last cell on the sheet is not where you think it is. I've seen cases where Excel thinks the UsedRange extends down to row 1048576.

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.