extracting data to tabs

[mcommon1]

I have a mass of data, say 30 columns by 1000 lines. I am looking at segregating this data by location (8 locations) in their own tab, so that a template can be made and additional data can be added to that tab by the location owner. how can I set up a function/formula so that it pulls out only that locations data in each tab, line by line?

Thanks in advance for your help!
Mark

 

[pboltonchina]

Try this on a copy of your data. This assumes your data is in Column A, change to suit your needs where it tells you to in the macro.

Option Explicit

Sub ParseItems()
'Jerry Beaucaire  (11/11/2009)
'Based on selected column, data is filtered to individual sheets
'Creates sheets and sorts sheets alphabetically in workbook
'6/10/2010 - added check to abort if only one value in vCol
Dim LR As Long, Itm As Long, MyCount As Long, vCol As Long
Dim WS As Worksheet, MyArr As Variant, vTitles As String, Oops As Boolean

Application.ScreenUpdating = False

'Column to evaluate from, column A = 1, B = 2, etc.
   vCol = 1
 
'Sheet with data in it
   Set WS = Sheets("Sheet1")

'Range where titles are across top of data, as string, data MUST
'have titles in this row, edit to suit your titles locale
    vTitles = "A1:E1"
   
'Spot bottom row of data
   LR = WS.Cells(WS.Rows.Count, vCol).End(xlUp).Row

'Get a temporary list of unique values from column A
    WS.Columns(vCol).SpecialCells(xlConstants).AdvancedFilter Action:=xlFilterCopy, _
        CopyToRange:=WS.Range("EE1"), Unique:=True

'Sort the temporary list
    WS.Columns("EE:EE").Sort key1:=WS.Range("EE2"), _
        Order1:=xlAscending, Header:=xlYes, ordercustom:=1, _
        MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

'Check for more than one value in list
    If WS.Range("EE" & Rows.Count).End(xlUp).Row > 2 Then

'Put list into an array for looping
'(values cannot be the result of formulas, must be constants)
        MyArr = Application.WorksheetFunction.Transpose(WS.Range("EE2:EE" _
            & Rows.Count).SpecialCells(xlCellTypeConstants))

'clear temporary worksheet list
        WS.Range("EE:EE").Clear

    Else
        WS.Range("EE:EE").Clear
        Oops = True
        GoTo ErrorExit
    End If
    
'Turn on the autofilter, one column only is all that is needed
    WS.Range(vTitles).AutoFilter

'Loop through list one value at a time
    For Itm = 1 To UBound(MyArr)
        WS.Range(vTitles).AutoFilter Field:=vCol, Criteria1:=MyArr(Itm)
    
        If Not Evaluate("=ISREF('" & MyArr(Itm) & "'!A1)") Then    'create sheet if needed
            Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = MyArr(Itm)
        Else                                                      'clear sheet if it exists
            Sheets(MyArr(Itm)).Move after:=Sheets(Sheets.Count)
            Sheets(MyArr(Itm)).Cells.Clear
        End If

    'customize this section as needed for copy/paste targets
        WS.Range("A" & WS.Range(vTitles).Resize(1, 1).Row & ":A" & LR) _
            .EntireRow.Copy Sheets(MyArr(Itm) & "").Range("A1")

        
        WS.Range(vTitles).AutoFilter Field:=vCol
        MyCount = MyCount + Sheets(MyArr(Itm)) _
            .Range("A" & Rows.Count).End(xlUp).Row - 1
        Sheets(MyArr(Itm)).Columns.AutoFit
    Next Itm
    
'Cleanup
    WS.AutoFilterMode = False
    MsgBox "Rows with data: " & (LR - 1) & vbLf & "Rows copied to other sheets: " _
                & MyCount & vbLf & "Hope they match!!"

ErrorExit:
    If Oops Then MsgBox "Only one value found, aborting parse process..."
    Application.ScreenUpdating = True
End Sub

 

[mcommon1]

THanks so much for the help... am getting 1004 error at :

'Get a temporary list of unique values from column A
WS.Columns(vCol).SpecialCells(xlConstants).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=WS.Range("EE1"), Unique:=True

I am admittedly a novice with vba... any thoughts?

Thanks again and best regards,
Mark

 

[pboltonchina]

Try it after removing

Option Explicit

 

[mcommon1]

Tried that as well.... I have excel 2010 btw.

Best regards,
Mark

 

[pboltonchina]

I know this works in Excel 2000, 2003 & 2007 and I have used it many times, but I don't have 2010 so I don't know if it's different in any way. You'll have to hope that one of the many 'gurus' on here (of which I am not), will jump to your rescue.

Sorry I can't be of any more assistance.

Regards
Paul

 

[mcommon1]

Thanks for your efforts and communication Paul, maybe I will downgrade for this purpose...

Best regards,
Mark

 

[mcommon1]

The issue is on this:

'Get a temporary list of unique values from column A
WS.Columns(vCol).SpecialCells(xlConstants).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=WS.Range("EE1"), Unique:=True

The error is "Run-time error 1004": This command requires at least 2 rows of source data. You cannot use the command on a selection in only one row. Try one of the following:
-If your using an advanced filter, select a range of cells that contains at least two rows of data. Then click the advanced filter command again


Thoughts anyone? Thi swould be a life saver if I could get it to work....

Best regarsd,
Mark

 

[jbeaucaire]

The problem is the xlConstants in that line of code, I believe, your data in the vCol must be formula-based.

The macro posted above has been updated to automatically detect whether the data is constants or formulas.

Sheet1 to Many Sheets​