VBA - create new sheet and organise data

[Padthelad]

Hi,

I am looking for VBA code to find a solution to a problem.

I have a master workbook with various ‘quote enquiries’. Usual things are included such as name, address, phone number, quote details. I also have a column that has the date a quote was sent (column M).

I would like a Macro that would search through the worksheet and create a new workbook with all the data from that row if column M is empty (quote sent column). Then organize from ‘oldest’ to ‘newest’.

Example of data below.

B

C

D

E

F

G

H

I

J

K

L

M

N

1

Number

TB

Date

Name

TB Type

Tel Number

Email

Address

Source

Entered By

Visit Date

Quote Sent

Price

2

1348

TB

02/07/2016

Test1

Badminton

12345

Test1@test

123 Testing

Yard

PD

2

1349

TB

02/07/2016

Test2

Windsor

6789

Test2@test

1234 Testing

Yard

PD

2

1350

TB

03/07/2016

Test3

Flimwell

101112

Test3@test

12345 Testing

Yard

PD

2

1351

TB

04/07/2016

Test4

Cowbeech

131415

Test4@test

123456 Testing

Yard

PD

3

4

5

<tbody>
</tbody>

So in summary, I am looking for VBA code that will search the entire worksheet and create a new workbook with all the data from the corresponding row if column M is empty (i.e no quote has been sent). I would like this to then be organised in date order (column D).

I t would be good to be able to run this Macro at the beginning of each day so that I can see any outstanding quotes that need to be sent.

Any help anyone can provide is very much appreciated. I have been looking for various codes for a week now but still can figure what I need.

Thank you in advance.

Pad

 

[Padthelad]

Ahh, right!

OK, so I have changed which column we use to find the "last row" of data from B to C. Try this:

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("Main").Cells(Rows.Count, "C").End(xlUp).Row
Set cRange = wb.Sheets("Main").Range("M4:M" & LastRow)

If Application.WorksheetFunction.CountIf(cRange, "") > 0 Then
    Set wb2 = Workbooks.Add
    wb.Sheets("Main").Range("A1:N3").Copy wb2.Sheets(1).Range("A1")
    LastRow2 = wb2.Sheets(1).Cells(Rows.Count, "B").End(xlUp).Row + 1
    
    For Each Cell In cRange
        If Cell.Value = "" 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("D4:D" & LastRow2).Sort Key1:=Range("D4"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

End Sub

You are my hero Fishboy! Thank you so much!

Pad

 

[Fishboy]

You are my hero Fishboy! Thank you so much!

Pad

Happy to help man