VBA to search column and copy entire rows to new sheet

[Padthelad]

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':-

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

<tbody>
</tbody>

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.

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

 

[baitmaster]

Are you using the Immediate Window? VB Editor > View > Immediate window

If you add the new lines of code I suggested, then when running / stepping through you will see a list of useful information that should help you understand why it's not working. You will have the following information:
1) the range you are looking at in each step along with its corresponding value
2) whether it was copied or not, and if so the row it was copied to (in case over-writing previous results)

If the value looks correct but it's not copying, then this will tell you there's something wrong with the value itself. Examples are hanging spaces at the end of the code, or case sensitivity. Check the text value itself, and add "Option Compare Text" at the top of the code module, before the start of the Sub (note this affects all code in the module). For further clarity you could amend the line

[COLOR=#ff0000]debug.print cell.address, cell.value[/COLOR][[COLOR=#ff0000][/COLOR]/CODE]
to
[CODE][COLOR=#ff0000]debug.print cell.address, "[" & cell.value & "]"[/COLOR]

as this will reveal hidden spaces

It's very common for code to not perform as expected and debug.print should be a standard approach that will help you to understand what's wrong