Solved VBA Sort Data, then Copy over the New Sheet

Microsoft Office 2010 home and student
April 4, 2013 at 13:47:51
Specs: Windows XP
So I have the simple spreadsheet named "Result".
                      A            B
1                  009584         Over
2                  006583         Good
3                  005842         Good
4                  165823         Over

So I want to sort out the "good" status ref # and then copy it over to new sheet named "Sheet1". What should be the appropriate way to do it? FYI, it is more than 250K rows, so it is why I am asking for VBA code. I know it I could use pivot table to sort and then copy & paste to the new sheet. However, I would like to learn VBA code for it to automate thing. Thank you in advance.


See More: VBA Sort Data, then Copy over the New Sheet

Report •


✔ Best Answer
April 5, 2013 at 10:32:03
First off, it looks to me like you are overwriting the last value in Sheet1 Column A every time you run the code.

This line returns the row of the last cell with data in Column A:

nxtRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row

This code pastes the first found row into that row and then increments the nxtRow variable:

      FoundNonCov.EntireRow.Copy
        Sheets("Sheet1").Range("A" & nxtRow).PasteSpecial
        nxtRow = nxtRow + 1

Seems to me like you are overwriting whatever is in the last cell of Column A. Perhaps you should increment the row counter before you do the paste.

As far as the 150 count difference, I have no way of knowing why that difference exists since I don't have a copy of your data.

You could trying using COUNTIF to see how many instances of "Good" you have in the Range("B2:B" & lastQueryRw) and see if the same number of rows were copied.

Keep in mind that the VBA .Find method is going to use whatever options are set in the Find/Replace wizard within Excel (not VBA) unless you specifically set them all within VBA. For example, if the wizard is set to match "Match entire cell contents", your VBA won't find "Good " (that's Good with a space after it.) Perhaps that is why you are getting a difference in the count.

If you are going to be writing VBA code, perhaps you should spend a little time reading this How To. It's pretty basic, but it's good place to start. You can go much deeper by searching the internet for the things that you want to do and including VBA in the search string.

http://www.computing.net/howtos/sho...

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.



#1
April 4, 2013 at 16:20:15
Sub SortNonCov()
Dim FoundNonCov As Range
nxtRow = Sheet4.Range("A" & Rows.Count).End(xlUp).Row + 1

With Worksheets("QueryResult").Range("B2:B234000")
    Set FoundNonCov = .Find("Good", LookIn:=xlValues)
    If Not FoundNonCov Is Nothing Then
        firstAddress = FoundNonCov.Address
    Do
        FoundNonCov.EntireRow.Copy
        Sheet4.Range("A" & nxtRow).PasteSpecial
        
        Set FoundNonCov = .FindNext(FoundNonCov)
    Loop While Not FoundNonCov Is Nothing And FoundNonCov.Address <> firstAddress
    End If
        
End With

End Sub




I wrote this code, but it does not work right. It copied the second cell found to A2 the Sheet4 and then keep changing it to new found until end. DerbyDad, please help me out in this one.


Report •

#2
April 4, 2013 at 16:53:23
Sub SortNonCov()

lastQueryRw = Sheets("QueryResult").Range("B" & Rows.Count).End(xlUp).Row
For nextAcc = 2 To lastQueryRw

With Worksheets("QueryResult").Range("B2:B" & lastQueryRw)
    Set FoundNonCov = .Find("Over", LookIn:=xlValues)
    If Not FoundNonCov Is Nothing Then
        FoundNonCov.EntireRow.Copy
        Sheets("Sheet3").Range("A" & nextAcc - 1).PasteSpecial
        
    End If
        
End With
Next
End Sub

This code works, but runs very slowly. I could use pivot table to sort faster. Is there a way I could sort it within VBA?


Report •

#3
April 5, 2013 at 06:26:59
The problem with the code in Response #1 is that you are determining the nxtRow in Sheet4 at the beginning of the code and never updating it after the first found row is pasted into Sheet4. You need to increment the nxtRow variable within the Do loop.

As far as the code in Response #2, looping through 234000 rows is going to be very slow. The code in Response #1 is much more efficient.

2 other points to mention:

1 - Hard coding the bottom of QueryResult Column B is probably not the best idea. Why not just let VBA determine the last row with data? That way your Do loop will always check the range that actually contains data, regardless if it's more or less than 234000 rows.

2 - Please try to be a little more patient when waiting for responses. We are all volunteers in this forum. We have real jobs and real lives. If you don't see an immediate response to your post, please don't keep asking for help. The help will come when and if it's available. For example, there was no need for you to post a request in your other thread for me to look at this one. We get to the posts when we have the time and the desire.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

Related Solutions

#4
April 5, 2013 at 07:13:20
Apologies for not being patient.

I fixed the code, it now copies down to next row as I want. However, I have to manually run the macro for every row. It does not automatically run the whole thing. Could you please check it out and correct me?

Thank you.

Sub SortNonCov()

Dim FoundNonCov As Range
'Determine nxtRow to paste special the data from QueryResult
nxtRow = Sheet4.Range("A" & Rows.Count).End(xlUp).Row + 1
'Determine last contained data row
lastQueryRw = Sheets("QueryResult").Range("B" & Rows.Count).End(xlUp).Row

With Worksheets("QueryResult").Range("B2:B" & lastQueryRw)
    Set FoundNonCov = .Find("Good", LookIn:=xlValues)
    If Not FoundNonCov Is Nothing Then
        firstAddress = FoundNonCov.Address
    Do
        FoundNonCov.EntireRow.Copy
        Sheet4.Range("A" & nxtRow).PasteSpecial
    Loop While Not FoundNonCov Is Nothing And FoundNonCov.Address <> firstAddress
        Set FoundNonCov = .FindNext(FoundNonCov)
        Sheet4.Range("A" & nxtRow).PasteSpecial
        
    
    End If
        
End With

End Sub


Report •

#5
April 5, 2013 at 08:37:53
I don't know why you moved the .FindNext instruction outside of the Do loop.

All instructions that you want to be applied across the entire range have to be inside the Do loop.

I also don't see where you added any code to increment the nxtRow variable. You have to use either ...

nxtRow = nxtRow + 1

or

nxtRow = Sheet4.Range("A" & Rows.Count).End(xlUp).Row + 1

... after the "found" row is pasted into Sheet4 so that VBA knows where to paste the next row it copies.

nxtRow = nxtRow + 1 is probably more efficient since it's a simple mathematical operation as opposed to asking VBA to determine the new last row every time.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#6
April 5, 2013 at 09:36:30
Thank you.

Here is an update code that works for me. Though it has a different count number when I compared this result with Pivot Table. It is about 150 rows out of 39,000 (not a major issue, but I just wonder why it is). Could I have a way to check on both to see which one should not be in the list.

Sub SortNonCov()

Dim FoundNonCov As Range
'Determine nxtRow to paste special the data from QueryResult
nxtRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
'Determine last contained data row
lastQueryRw = Sheets("QueryResult").Range("B" & Rows.Count).End(xlUp).Row

With Worksheets("QueryResult").Range("B2:B" & lastQueryRw)
    'Look up "Good" within the range
    Set FoundNonCov = .Find("Good", LookIn:=xlValues)
    'Set firstAddress, so they won't copy cells already found and paste to new sheet
    If Not FoundNonCov Is Nothing Then
        firstAddress = FoundNonCov.Address
    'Loop through the whole set of data and then copy&paste to new sheet
    Do
        FoundNonCov.EntireRow.Copy
        Sheets("Sheet1").Range("A" & nxtRow).PasteSpecial
        nxtRow = nxtRow + 1
        Set FoundNonCov = .FindNext(FoundNonCov)
    Loop While Not FoundNonCov Is Nothing And FoundNonCov.Address <> firstAddress
    End If
End With
End Sub



Report •

#7
April 5, 2013 at 10:32:03
✔ Best Answer
First off, it looks to me like you are overwriting the last value in Sheet1 Column A every time you run the code.

This line returns the row of the last cell with data in Column A:

nxtRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row

This code pastes the first found row into that row and then increments the nxtRow variable:

      FoundNonCov.EntireRow.Copy
        Sheets("Sheet1").Range("A" & nxtRow).PasteSpecial
        nxtRow = nxtRow + 1

Seems to me like you are overwriting whatever is in the last cell of Column A. Perhaps you should increment the row counter before you do the paste.

As far as the 150 count difference, I have no way of knowing why that difference exists since I don't have a copy of your data.

You could trying using COUNTIF to see how many instances of "Good" you have in the Range("B2:B" & lastQueryRw) and see if the same number of rows were copied.

Keep in mind that the VBA .Find method is going to use whatever options are set in the Find/Replace wizard within Excel (not VBA) unless you specifically set them all within VBA. For example, if the wizard is set to match "Match entire cell contents", your VBA won't find "Good " (that's Good with a space after it.) Perhaps that is why you are getting a difference in the count.

If you are going to be writing VBA code, perhaps you should spend a little time reading this How To. It's pretty basic, but it's good place to start. You can go much deeper by searching the internet for the things that you want to do and including VBA in the search string.

http://www.computing.net/howtos/sho...

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#8
April 5, 2013 at 11:30:01
Thank you for the help. I am reading the How To now.

Report •


Ask Question