Array - filter by one column but save as by another column

Question

Good Afternoon,

I'm new to using arrays and a little confused with my code. The purpose is to filter my spreadsheet by the value in one column and then doing a SaveAs by the value in another column. I've been researching, and changing, this code since yesterday and can't make it happen.

Option Explicit

Sub splitTEST()

Dim LR As Long, Itm As Long, MyCount As Long, vCol As Long, i As Long, CountArr As Long
Dim ws As Worksheet, MyArr As Variant, ArrName As Variant, vTitles As String, SvPath As String

Set ws = Sheets("Sheet2")
vTitles = "A1:Q1"

vCol = Application.InputBox("What column to split data by? " & vbLf _
    & vbLf & "(A=1, B=2, C=3, etc)", "Which column?", 1, Type:=1)
If vCol = 0 Then Exit Sub      'choose which column to filter, in this case 11

LR = ws.Cells(ws.Rows.Count, vCol).End(xlUp).Row

Application.ScreenUpdating = False

 ws.Columns(vCol).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws.Range("EE1"), Unique:=True

 ws.Columns("EE:EE").Sort Key1:=ws.Range("EE2"), Order1:=xlAscending, Header:=xlYes, _
   OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

MyArr = Application.WorksheetFunction.Transpose(ws.Range("EE2:EE" & Rows.Count).SpecialCells(xlCellTypeConstants))

ArrName = Application.WorksheetFunction.Transpose(ws.Range("L2:L" & Rows.Count).SpecialCells(xlCellTypeConstants))     'column with name that determine SAVEAS name

ws.Range("EE:EE").Clear

ws.Range(vTitles).AutoFilter

For Itm = 1 To UBound(MyArr)            'filter by, add new workbook, add two sheets
    ws.Range(vTitles).AutoFilter Field:=vCol, Criteria1:=MyArr(Itm)
    ws.Range("A1:A" & LR).EntireRow.Copy
    Workbooks.Add
    Range("A1").PasteSpecial xlPasteAll
    Cells.Columns.AutoFit
    MyCount = MyCount + Range("A" & Rows.Count).End(xlUp).Row - 1
    Worksheets.Add Before:=Worksheets(Worksheets.Count)

    For i = 1 To UBound(ArrName)         'selecting the name to save the workbook
        ws.Range("A1:A" & LR).EntireRow.Copy
        CountArr = CountArr + Range("A" & Rows.Count).End(xlUp).Row - 1
        ActiveWorkbook.SaveAs SvPath & ArrName & ".xlsx", 51
    Next

    ActiveWorkbook.Close False

Next Itm


ws.AutoFilterMode = False
MsgBox "Rows with data: " & (LR - 1) & vbLf & "Rows copied to other sheets: " & MyCount & vbLf & "Hope they match!!"
Application.ScreenUpdating = True

 End Sub     'Jerry Beaucaire (4/22/2010)

Code is a bit of a mess...Blame Jerry? What specific issues are you having? What errors are you getting and where? — nwhaught
– nwhaught, Commented Mar 23, 2015 at 18:15

Sobigen · Accepted Answer · 2015-03-23 18:18:30Z

1

I see a problem in this line:

ActiveWorkbook.SaveAs SvPath & ArrName & ".xlsx", 51

You don't iterate on ArrName. I think it should be:

ActiveWorkbook.SaveAs SvPath & ArrName(i) & ".xlsx", 51

That's at least one of your problems.

answered Mar 23, 2015 at 18:18

Sobigen

2,17916 silver badges25 bronze badges

Sign up to request clarification or add additional context in comments.

Collectives™ on Stack Overflow

Array - filter by one column but save as by another column

1 Answer 1

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

Comments

Your Answer

Sign up or log in

Post as a guest

Related