Thread: Macro for creating new workbook based on Decision Dates/Industry

Hi Arlette,

I tried running it but I get "Run Time" error message and when I hit debug - it highlights lrow = .Range("A" & Rows.Count).End(xlUp).Row
in yellow.

It does create a new file named "Output file" which is blank.

Please help!!!!

I see that you are from Bangalore. If you could give me your mobile # so that I could talk to you would be nice.

Regards,
Sunil Wadhwa

Originally Posted by arlu1201

Copy this code in a blank module (Press on Alt + F11, right click on Microsoft excel objects on the left hand side, select insert->module).

Option Explicit
Dim FName As String
Dim SName As String
Dim lrow As Long
Dim i As Long

Sub filter_rows()

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Workbooks.Add
ActiveWorkbook.SaveAs ("Output File")
FName = ActiveWorkbook.Name

With ThisWorkbook.Worksheets(1)
    lrow = .Range("A" & Rows.Count).End(xlUp).Row
    For i = 15 To lrow
        If .Range("U" & i).Value = Date + 7 Then
            SName = .Range("X" & i).Value
            If Not Evaluate("ISREF('" & SName & "'!A1)") Then
                Workbooks(FName).Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = SName
                .Rows("14:14").Copy Workbooks(FName).Worksheets(SName).Range("A1")
            End If
            .Rows(i & ":" & i).Copy Workbooks(FName).Worksheets(SName).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        End If
    Next i
End With

With Workbooks(FName)
    .Worksheets("Sheet1").Delete
    .Worksheets("Sheet2").Delete
    .Worksheets("Sheet3").Delete
End With

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

The data is on sheet8. The error message I get is -

Runtime Error "1004"
Application defined or Object defined error

Then when I hit "Debug" option it takes me to this code -

lrow = .Range("A" & Rows.Count).End(xlUp).Row

Originally Posted by arlu1201

Is your data on worksheet 1? Whats the error msg?

I have attached screenshots of the error messages I get. Hope you can help

Originally Posted by arlu1201

Will your sheet name remain constant always? Then you can change this line -

 With Thisworkbook.worksheets(1)

to this

 With ThisWorkbook.Worksheets("sheet8")

I am currently out of station so working from here.

Just to remind you - my data starts from Row 14 column M. Not sure if this is the reason for the error.....just guessing

Originally Posted by arlu1201

Will your sheet name remain constant always? Then you can change this line -

 With Thisworkbook.worksheets(1)

to this

 With ThisWorkbook.Worksheets("sheet8")

I am currently out of station so working from here.

I get a new error now on this code -

.Worksheets("Sheet3").Delete

It does not give me any error message when I run the macro this time but the output file is blank without any data on it.

Hi,

Got a new error message on this code now -

Workbooks(FName).Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = SName

Originally Posted by arlu1201

Just change this line -

 If .Range("U" & i).Value = Date + 7 Then

to

 If .Range("U" & i).Value <= Date + 7 Then

If there is no data corresponding to the dates less than next thursday's date, you wont see any data in the file.

Bump no response

Originally Posted by sunilwadhwa

Hi,
Can someone please help me create a macro with the attached Excel (sample)Spreadsheet.

I receive this file every Thursday. Then I filter on "Decision Date" (column U)with "Is Before or equal to" and select next Thursday's date. Once I have done that I know this is the list of opportunities which is nearing/past their decision date.

I now filter on Ind Name (Column X) and open a new workbook and paste data on each worksheet based on an Industry. There are 4 industries - Consumer Products, Life Sciences, Retails, Travel and Transportation. So my new sheet has for tabs and data pasted on these respective tabs.

Can someone please help me create a macro so that I don't have to do this manually every week.

Spreadsheet attached for your reference.