Macros to create new excel files based on criteria

[fsuguy92]

Hey guys, I have an excel file that I need to create 4 separate files from. In column A I have either "Clean" or "Not Clean" and in column B I have either "NFL", "MLS", or "REMOVE".

What I need is a macro that will create 4 files : Clean & NFL, Not Clean & NFL, Clean & MLS, Not Clean & MLS. I only need it to export columns B:CL and it can ignore anything that has "REMOVE" in column B.

Not sure how difficult this is or if it's even possible but it would be a HUGE help! I'm in the process of learning VBA but this is a little above and beyond my capabilities at the moment. Thank you!!

 

[Fluff]

How about

Sub fsuguy92()
   Dim Ary1 As Variant, Ary2 As Variant
   Dim i As Long, j As Long
   Ary1 = Array("clean", "not clean")
   Ary2 = Array("NFL", "MLS")
   Application.ScreenUpdating = False
   With Sheets("[COLOR=#ff0000]Sheet1[/COLOR]")
      For i = 0 To UBound(Ary1)
         For j = 0 To UBound(Ary2)
            .Range("A1:CL1").AutoFilter 1, Ary1(i)
            .Range("A1:CL1").AutoFilter 2, Ary2(j)
            Workbooks.Add
            .AutoFilter.Range.Offset(, 1).Copy Sheets(1).Range("A1")
            ActiveWorkbook.SaveAs Ary1(i) & "_" & Ary2(j) & ".xlsm", 52
            ActiveWorkbook.Close False
         Next j
      Next i
      .AutoFilterMode = False
   End With
End Sub

Change sheet name in red to suit

 

[fsuguy92]

How about

Sub fsuguy92()
   Dim Ary1 As Variant, Ary2 As Variant
   Dim i As Long, j As Long
   Ary1 = Array("clean", "not clean")
   Ary2 = Array("NFL", "MLS")
   Application.ScreenUpdating = False
   With Sheets("[COLOR=#ff0000]Sheet1[/COLOR]")
      For i = 0 To UBound(Ary1)
         For j = 0 To UBound(Ary2)
            .Range("A1:CL1").AutoFilter 1, Ary1(i)
            .Range("A1:CL1").AutoFilter 2, Ary2(j)
            Workbooks.Add
            .AutoFilter.Range.Offset(, 1).Copy Sheets(1).Range("A1")
            ActiveWorkbook.SaveAs Ary1(i) & "_" & Ary2(j) & ".xlsm", 52
            ActiveWorkbook.Close False
         Next j
      Next i
      .AutoFilterMode = False
   End With
End Sub

Change sheet name in red to suit

I'm getting a "run-time error 1004" when I try to run this macro. I also realized that I misspoke - I need it to be NFL & Clean+Not Clean and then an NFL Clean, and then MLS Clean+Not Clean and an MLS Clean. So 4 sheets in total - I appreciate the help!

 

[Fluff]

How about

Sub fsuguy92()
   Dim Ary As Variant
   Dim i As Long, j As Long
   Ary = Array("NFL", "MLS")
   Application.ScreenUpdating = False
   With Sheet1
      For i = 0 To UBound(Ary)
         For j = 1 To 2
            .Range("A1:CL1").AutoFilter 1, IIf(j = 1, "*", "Clean")
            .Range("A1:CL1").AutoFilter 2, Ary(i)
            Workbooks.Add
            .AutoFilter.Range.Offset(, 1).Copy Sheets(1).Range("A1")
            ActiveWorkbook.SaveAs Ary(i) & IIf(j = 1, "_Clean+Not Clean", "_Clean") & ".xlsm", 52
            ActiveWorkbook.Close False
         Next j
      Next i
      .AutoFilterMode = False
   End With
End Sub

Assuming you still get the error, what is the error message & what line gives the error.

 

[fsuguy92]

How about

Sub fsuguy92()
   Dim Ary As Variant
   Dim i As Long, j As Long
   Ary = Array("NFL", "MLS")
   Application.ScreenUpdating = False
   With Sheet1
      For i = 0 To UBound(Ary)
         For j = 1 To 2
            .Range("A1:CL1").AutoFilter 1, IIf(j = 1, "*", "Clean")
            .Range("A1:CL1").AutoFilter 2, Ary(i)
            Workbooks.Add
            .AutoFilter.Range.Offset(, 1).Copy Sheets(1).Range("A1")
            ActiveWorkbook.SaveAs Ary(i) & IIf(j = 1, "_Clean+Not Clean", "_Clean") & ".xlsm", 52
            ActiveWorkbook.Close False
         Next j
      Next i
      .AutoFilterMode = False
   End With
End Sub

Assuming you still get the error, what is the error message & what line gives the error.

Looks like this line is causing an error - I'm able to hit F8 and it seems to get hung up on this line...
.AutoFilter.Range.Offset(, 1).Copy Sheets(1).Range("A1")

 

[Fluff]

What is the error message?

 

[fsuguy92]

It's giving "Run-time error '100': Application-defined or object-defined error"

 

[Fluff]

How about

Sub fsuguy92()
   Dim Ary As Variant
   Dim i As Long, j As Long
   Dim Wbk As Workbook
   Ary = Array("NFL", "MLS")
   Application.ScreenUpdating = False
   With Sheets("[COLOR=#ff0000]Sheet1[/COLOR]")
      For i = 0 To UBound(Ary)
         For j = 1 To 2
            .Range("A1:CL1").AutoFilter 1, IIf(j = 1, "*", "Clean")
            .Range("A1:CL1").AutoFilter 2, Ary(i)
            Set Wbk = Workbooks.Add
            .AutoFilter.Range.Offset(, 1).Copy Wbk.Sheets(1).Range("A1")
            Wbk.SaveAs Ary(i) & IIf(j = 1, "_Clean+Not Clean", "_Clean") & ".xlsm", 52
            Wbk.Close False
         Next j
      Next i
      .AutoFilterMode = False
   End With
End Sub

 

[fsuguy92]

I've changed some things on my workbook that I think could make this much easier! In column A, I now have a 0,1,2,3 or 4 in that column based on specific criteria. I would like the macro to export columns C:CM for all data that has 1 in column A and export it to another worksheet, everything with 2 in column A and export to another... and so on and so forth. I figure that should make it much easier right?!

 

[Fluff]

Not without finding out why you are getting the error.