VBA to search column and copy entire rows to new sheet

P

Padthelad

Board Regular
Joined
May 13, 2016
Messages
64
Office Version
  1. 2016
Platform
  1. Windows
Hello,

I have a problem where I want to be able to search a particular column and then copy that entire row to a new workbook based on the value found in the particular column.

I have the following worksheet called '2016':-

[TABLE="width: 1709"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[TD]G[/TD]
[TD]H[/TD]
[TD]I[/TD]
[TD]J[/TD]
[TD]K[/TD]
[TD]L[/TD]
[TD]M[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]DATE[/TD]
[TD]NAME[/TD]
[TD]DATE PAID[/TD]
[TD]INV NO[/TD]
[TD]NET[/TD]
[TD]VAT[/TD]
[TD]TOTAL[/TD]
[TD]Daily net[/TD]
[TD]Gross Total Outstanding[/TD]
[TD][/TD]
[TD]Net LC[/TD]
[TD]Net TB[/TD]
[TD]Monthly Totals[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]06/10/2016[/TD]
[TD]Customer 1[/TD]
[TD]06/10/2016[/TD]
[TD]38216[/TD]
[TD]130.68[/TD]
[TD]26.14[/TD]
[TD]156.82[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]06/10/2016[/TD]
[TD]TB - TB101 Customer 2[/TD]
[TD]deposit paid[/TD]
[TD]38217[/TD]
[TD]11,990.00[/TD]
[TD]2,398.00[/TD]
[TD]14,388.00[/TD]
[TD][/TD]
[TD="align: right"]7194.00[/TD]
[TD]Balance Remain[/TD]
[TD][/TD]
[TD="align: right"]11990.00[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]06/10/2016[/TD]
[TD]TB - TB102 Customer 3[/TD]
[TD]deposit paid[/TD]
[TD]38218[/TD]
[TD]1,170.00[/TD]
[TD]234.00[/TD]
[TD]1,404.00[/TD]
[TD][/TD]
[TD="align: right"]702.00[/TD]
[TD]Balance Remain[/TD]
[TD][/TD]
[TD="align: right"]1170.00[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]06/10/2016[/TD]
[TD]MM - MM101 Customer 4[/TD]
[TD]deposit paid[/TD]
[TD]38219[/TD]
[TD]4,383.33[/TD]
[TD]876.67[/TD]
[TD]5,260.00[/TD]
[TD][/TD]
[TD="align: right"]2630.00[/TD]
[TD]Balance Remain[/TD]
[TD="align: right"]4383.33[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]06/10/2016[/TD]
[TD]Customer 5[/TD]
[TD][/TD]
[TD]38220[/TD]
[TD]117.00[/TD]
[TD]23.40[/TD]
[TD]140.40[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]06/10/2016[/TD]
[TD]TB - TB103 Customer 6[/TD]
[TD]deposit paid[/TD]
[TD]38221[/TD]
[TD]258.33[/TD]
[TD]51.67[/TD]
[TD]310.00[/TD]
[TD="align: right"]18,049.34[/TD]
[TD="align: right"]155.00[/TD]
[TD]Balance Remain[/TD]
[TD][/TD]
[TD="align: right"]258.33[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]8[/TD]
[TD]07/10/2016[/TD]
[TD]Customer 7[/TD]
[TD][/TD]
[TD]38222[/TD]
[TD]3.92[/TD]
[TD]0.78[/TD]
[TD]4.70[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]9[/TD]
[TD]07/10/2016[/TD]
[TD]Customer 8[/TD]
[TD][/TD]
[TD]38223[/TD]
[TD]127.37[/TD]
[TD]25.47[/TD]
[TD]152.84[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]10[/TD]
[TD]07/10/2016[/TD]
[TD]Customer 9[/TD]
[TD]07/10/2016[/TD]
[TD]38224[/TD]
[TD]231.05[/TD]
[TD]46.21[/TD]
[TD]277.26[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]11[/TD]
[TD]07/10/2016[/TD]
[TD]Customer 10[/TD]
[TD][/TD]
[TD]38225[/TD]
[TD]928.05[/TD]
[TD]185.61[/TD]
[TD]1,113.66[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]12[/TD]
[TD]07/10/2016[/TD]
[TD]Customer 11[/TD]
[TD][/TD]
[TD]38226[/TD]
[TD]238.83[/TD]
[TD]47.77[/TD]
[TD]286.60[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]13[/TD]
[TD]07/10/2016[/TD]
[TD]Customer 12[/TD]
[TD][/TD]
[TD]38227[/TD]
[TD]92.73[/TD]
[TD]18.55[/TD]
[TD]111.28[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


I would like VBA code to be able to search column C for "deposit paid", if this parameter is met, I would like to copy the entire row to a new workbook, including formatting.

I am currently using the following code, however it only copies the workbook headers and first row but without using the 'Column C' parameters I require.

Code: 
Sub GenerateList()
Dim Cell As Range, cRange As Range
Dim LastRow As Long, LastRow2 As Long
Dim wb As Workbook, wb2 As Workbook



Set wb = ActiveWorkbook


LastRow = wb.Sheets("2016").Cells(Rows.Count, "A").End(xlUp).Row
Set cRange = wb.Sheets("2016").Range("M2:M" & LastRow)


If Application.WorksheetFunction.CountIf(cRange, "") > 0 Then
    Set wb2 = Workbooks.Add
    wb.Sheets("2016").Range("A1:M2").Copy wb2.Sheets(1).Range("A2")
    LastRow2 = wb2.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    For Each Cell In cRange
       
        If Cell.Value = "deposit paid" Then
            Cell.EntireRow.Copy
            wb2.Sheets(1).Range("A" & LastRow2).PasteSpecial xlPasteFormats
            wb2.Sheets(1).Range("A" & LastRow2).PasteSpecial xlValues
            LastRow2 = LastRow2 + 1
        End If
    Next Cell
End If


wb2.Sheets(1).Range("A2:A" & LastRow2).Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal


End Sub

Any help anyone can provide is very much appreciated.

Many thanks,

Pad
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
Sort by date Sort by votes
I can't see anything glaringly obvious, so I suggest you do some debugging.

Make sure you can see the immediate window and the locals window, plus try to have both the VB Editor and the Excel window visible at the same time - use 2 screens if you can

Add a break point at the line [For Each Cell In cRange]. Your code will run to this point. Then step through the code a line at a time by hitting F8. You should see the relevant changes happening to your Excel files. You should also see the way that your code is moving through your loops (if at all) and the values of the different variables as you step through. You can write individual lines of code in the immediate window at any time to change variables or ask questions, and you can pass text / values to this window using the line [debug.print "my text here" & myVariable]
 
Upvote 0
Try this:
Code: 
Sub GenerateList()
Dim Cell As Range, cRange As Range
Dim LastRow As Long, LastRow2 As Long
Dim wb As Workbook, wb2 As Workbook






Set wb = ActiveWorkbook




LastRow = wb.Sheets("2016").Cells(Rows.Count, "A").End(xlUp).Row
Set cRange = wb.Sheets("2016").Range("C2:C" & LastRow) ' changed




If Application.WorksheetFunction.CountIf(cRange, "") > 0 Then
    Set wb2 = Workbooks.Add
    wb.Sheets("2016").Range("A1:M1").Copy wb2.Sheets(1).Range("A1")  'changed
    LastRow2 = wb2.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    For Each Cell In cRange
       
        If Cell.Value = "deposit paid" Then
            Cell.EntireRow.Copy
            wb2.Sheets(1).Range("A" & LastRow2).PasteSpecial xlPasteFormats
            wb2.Sheets(1).Range("A" & LastRow2).PasteSpecial xlValues
            LastRow2 = LastRow2 + 1
        End If
    Next Cell
End If




wb2.Sheets(1).Range("A2:A" & LastRow2).Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal




End Sub
You can say "THANK YOU" for help received by clicking "Like" in the bottom right corner of the helper's post.
 
Upvote 0
ah yes, you're using column M to determine the end of the table. I hardly ever use this common approach, for me the following is a more robust solution, it considers the actual last used row of the whole worksheet - not just one column, it ignores "dead space" within the usedrange object, and returns 0 for empty sheets; it is also easy to use anywhere:
Code: 
Function lastUsedRow(ws As Worksheet) As LongOn Error Resume Next
    lastUsedRow = ws.Cells.Find("*", Range("A1"), xlFormulas, , xlByRows, xlPrevious).Row
On Error GoTo 0
End Function
Call it at any time using e.g. [lastUsedRow(sheet1)]
 
Upvote 0
baitmaster said:
ah yes, you're using column M to determine the end of the table. I hardly ever use this common approach, for me the following is a more robust solution, it considers the actual last used row of the whole worksheet - not just one column, it ignores "dead space" within the usedrange object, and returns 0 for empty sheets; it is also easy to use anywhere:
Code: 
Function lastUsedRow(ws As Worksheet) As LongOn Error Resume Next
    lastUsedRow = ws.Cells.Find("*", Range("A1"), xlFormulas, , xlByRows, xlPrevious).Row
On Error GoTo 0
End Function
Call it at any time using e.g. [lastUsedRow(sheet1)]
Click to expand...

Thank you for your comments.

I am afraid I am still having the same problem that all the data is not copied to the new workbook. Only the header and first line.

I also, don't quite understand 'function lastUsedRow' comment.

Sorry but do you have any further suggestions to solve my issue. I feel I am close....

Many thanks,

Patrick
 
Upvote 0
There are several types of macro, you usually use Subs but you can also use Functions. Functions are very similar, but return a variable value to wherever the function was called from

So you can have a code module containing just the Function stated above, and then in a macro make your variable = the result from the function. In your example, rather than
Code: 
LastRow = wb.Sheets("2016").Cells(Rows.Count, "A").End(xlUp).Row
I would write
Code: 
LastRow = lastusedrow(wb)
this calls the function, passes the wb object into it, and assigns the result to the variable LastRow

Functions have further uses, in that they can be used to create your own spreadsheet formulas which you can use within cells. These are known as UDFs (user-defined functions) - for when you need something so specialised that standard formulas just can't hack it
 
Upvote 0
baitmaster said:
There are several types of macro, you usually use Subs but you can also use Functions. Functions are very similar, but return a variable value to wherever the function was called from

So you can have a code module containing just the Function stated above, and then in a macro make your variable = the result from the function. In your example, rather than
Code: 
LastRow = wb.Sheets("2016").Cells(Rows.Count, "A").End(xlUp).Row
I would write
Code: 
LastRow = lastusedrow(wb)
this calls the function, passes the wb object into it, and assigns the result to the variable LastRow

Functions have further uses, in that they can be used to create your own spreadsheet formulas which you can use within cells. These are known as UDFs (user-defined functions) - for when you need something so specialised that standard formulas just can't hack it
Click to expand...

Oh I see. This seems to be an asthetic issue to make the code look cleaner. I appreciate you informing and improving my understanding, however, I am still unable to have my code execute what I desire.

Do you have any further thoughts on why this VBA is not 'searching column C and copying the entire row to a new workbook if ' depsoit paid' is found'?

Many thanks,

Patrick
 
Upvote 0
It's not just aesthetics, it's the best way to accurately identify the size of the used range of data on a worksheet, plus it's easier to work with and hence reduces potential for errors. There's a worksheet.usedrange object but it's prone to inaccuracy when data is deleted so I avoid it.

Did you follow the debugging steps I suggested? what happened, did the code go through the loops as expected or jump out unexpectedly?

Add the following lines and tell me what happens in the Immediate window once you've run your code:
Code: 
    For Each Cell In cRange
       [COLOR=#FF0000]debug.print cell.address, cell.value[/COLOR]
        If Cell.Value = "deposit paid" Then
            [COLOR=#FF0000]debug.print "copying to row " & lastrow2[/COLOR]
            Cell.EntireRow.Copy
            wb2.Sheets(1).Range("A" & LastRow2).PasteSpecial xlPasteFormats
            wb2.Sheets(1).Range("A" & LastRow2).PasteSpecial xlValues
            LastRow2 = LastRow2 + 1
        [COLOR=#FF0000]else
            debug.print "not copied"[/COLOR]
        End If
    Next Cell
 
Upvote 0
baitmaster said:
It's not just aesthetics, it's the best way to accurately identify the size of the used range of data on a worksheet, plus it's easier to work with and hence reduces potential for errors. There's a worksheet.usedrange object but it's prone to inaccuracy when data is deleted so I avoid it.

Did you follow the debugging steps I suggested? what happened, did the code go through the loops as expected or jump out unexpectedly?

Add the following lines and tell me what happens in the Immediate window once you've run your code:
Code: 
    For Each Cell In cRange
       [COLOR=#FF0000]debug.print cell.address, cell.value[/COLOR]
        If Cell.Value = "deposit paid" Then
            [COLOR=#FF0000]debug.print "copying to row " & lastrow2[/COLOR]
            Cell.EntireRow.Copy
            wb2.Sheets(1).Range("A" & LastRow2).PasteSpecial xlPasteFormats
            wb2.Sheets(1).Range("A" & LastRow2).PasteSpecial xlValues
            LastRow2 = LastRow2 + 1
        [COLOR=#FF0000]else
            debug.print "not copied"[/COLOR]
        End If
    Next Cell
Click to expand...

Hi Bait,

Thank you for your response.

I did run through the debugging steps you suggested line by line using F8. As expected the code created the new sheet, then copied the headers and first line, but then continued through the loop without copying any of the data over.

I'm really confused as to why this wont work.

Sorry to be a pain.

Many thanks,

Pad
 
Upvote 0
Try this code:

Code: 
Sub CopyRows()
    
    Dim LR As Integer
    Dim wb As Workbook, wb2 As Workbook
    Set wb = ActiveWorkbook
    Set wb2 = Workbooks.Add
    Application.ScreenUpdating = False
    LR = wb.Sheets("2016").Range("A" & Rows.Count).End(xlUp).Row
    Dim rng As Range
    wb.Sheets("2016").Range("A1:M1").Copy wb2.Sheets(1).Range("A1")
    For Each rng In wb.Sheets("2016").Range("C2:C" & LR)
        If rng = "deposit paid" Then
            rng.EntireRow.Copy wb2.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        End If
    Next rng
    wb2.Sheets(1).Columns.AutoFit   
    Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Solved
Code to search job id from multiple sources and update main spreadsheet.
2
Replies
10
Views
594
mumps
mumps
Logit
  • Question Question
Search In Other Workbook - Copy/Paste Offset Data To First Workbook - Repeat Process
Replies
7
Views
261
Logit
Logit
G
  • Question Question
Copying and pasting between two workbooks
Replies
1
Views
693
rlv01
R
N
  • Question Question
Finding the differences then copy and paste code to a new sheet
Replies
1
Views
568
myall_blues
myall_blues
O
  • Solved
Merge data in listbox based on another listbox after search for name and dates
Replies
6
Views
154
Omran Y
O

Forum statistics

Threads
1,223,162
Messages
6,170,432
Members
452,326
Latest member
johnshaji

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top