Thread: Breaking up one sheet into multiple sheets by a row identifier (mgr name)

Cullen

See if the attached gets you going.

rylo

Amazing!

You guys are awesome! Thank you, thank you, thank you…

If you are ever in the Houston area I owe you guys a beer! You saved me hours!

Thanks again,
Cullen

This worked amazing for me as well! Did exactly what I needed it to do.

Sonia

This is very similar to what I am trying to do, except I want to save to different workbooks and not just spreadsheets. I have about 2800 records split among ~250 account codes.

First I import the raw data, remove a couple of blank rows between the title row and the data, replace some blank fields in the collator code column (D), and then sort on the collator code. Then I apply the code you had created.

I left out the Employee Col reference, and changed any reference to "Supervisor" reference to CollatorCode (ie. Dim strCollatorCode As String). I also left out the sorting code, as I had done that earlier in the coding.

Otherwise I have kept everything the same. I still need to adapt the Sub "CreateCollatorCodeSheet" to "CreateCollatorCodeBook", but tried running it first to see if it would work.

I get "Invalid use of the Me keyword" when it tries to compile. I am not an expert in VBA, so I am not sure what to do next.

Any Suggestions?

Here is the code (the subtotal code at the bottom is remarked out, as that what I was doing before, but not what the end user wants):

Option Explicit
Sub Open_and_Copy_VoIP_Source_Data()
'
' Opening Message
'
MsgBox "This macro will import the data from the orginal file and reformat it for printing"
MsgBox "The original file MUST be located in the same directory as this file, and MUST be call 'VoIP Billing Report.xls'"
MsgBox "Click 'OK' to continue, or press [CTRL]+[BREAK] and click on 'end' to stop the macro now"

' Clear Existing Worksheet Data
'
    Cells.Select
    Selection.RemoveSubtotal
    Selection.ClearContents
    ActiveWorkbook.Save
    Range("A1").Select

' Open and Copy VoIP Source Data

    Dim strSSPath As String
    strSSPath = ActiveWorkbook.Path
    Workbooks.Open Filename:=strSSPath & "\VoIP Billing Report.xls"
    Cells.Select
    Selection.Copy
    Windows("IPT Billing Info from Call Manager.xlsm").Activate
    Cells.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Rows("2:3").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
'
' Replace Blanks with name
'
    Columns("D:D").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.FormulaR1C1 = "=RC[-3]"
    Range("A1").Select
'
' Sort by Collator Code
'
    Rows("1:1").Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("VoIP Billing Info").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("VoIP Billing Info").AutoFilter.Sort.SortFields.Add Key:=Range _
        ("D1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("VoIP Billing Info").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A1").Select
'
'Split into separate worksheets based on Collator Code
'
Dim wsh As Worksheet, wshMain As Worksheet
Dim cel As Range
Dim intFirstDataRow As Integer, intHeaderRow As Integer, intFirstDataCol As Integer, intLastDataCol As Integer
Dim LngLastDataRow As Long, i As Long, j As Long, lngStartRow As Long, LngEndRow As Long
Dim stryCopyRange As String, strCollatorCodeCol As String
'
'initialize
'
    intHeaderRow = 1
    intFirstDataRow = intHeaderRow + 1
    intFirstDataCol = 1
    strCollatorCodeCol = 4
    Set wshMain = Me
    LngLastDataRow = Me.Range("A" & intFirstDataCol).SpecialCells(xlCellTypeLastCell).Row
    intLastDataCol = Me.Range("A" & intHeaderRow).End(xlToRight).Column
    ReDim varCollatorCodeData(LngLastDataRow, intLastDataCol)
'
'First clear out all other worksheets
'
Application.DisplayAlerts = False
For Each wsh In Thisworksheet.Worksheets
    If wsh.Name <> Me.Name Then
        wsh.Delete
    End If
    Next wsh
Application.DispalyAlerts = True
'
lngStartRow = intFirstDataRow
For Each cel In Range(strCollatorCodeCol & intFirstDataRow & ":" & strCollatorCodeCol & LngLastDataRow)
    If cel.Offset(1, 0).Value = cel.Value Then
        LngEndRow = cel.Offset(1#).Row
        'skip / next
    Else
        StrCopyRange = Range(strCollatorCodeCol & lngStartRow & ":" & strCollatorCodeCol & lngStartRow).EntireRow.Address
        Call CreateCollatorCodeSheet(wshMain.Name, Range(strCollatoCodeCol & lngStartRow).Value, StrCopyRange, intHeaderRow, intFirstDataRow)
        lngStartRow = LngEndRow + 1
        LngEndRow = lngStartRow
    End If
    Next cel
    wsgMain.Activate
    
End Sub

Sub CreateCollatorCodeSheet(strMainSheet, strCollatorCode, strRange, intTitleRow, intDataRow)
    ActiveWorkbook.Worksheets.Add after:=Worksheets(Worksheets.Count)
    Worksheets(Worksheets.Count).Name = strCollatorCode
    Worksheets(strMainSheet).Range("A1").EntireRow.Copy Destination:=Worksheets(strCollatorCode).Range("A" & inTitleRow)
    Worksheets(strMainSheet).Rang(strRange).EntireRow.Copy Destination:=Worksheets(strCollatorCode).Range("A" & intDataRow)
End Sub
    
        
    




'
' Count by Collator Code
'
'    Cells.Select
'    Selection.Subtotal GroupBy:=4, Function:=xlCount, TotalList:=Array(4), _
'        Replace:=True, PageBreaks:=True, SummaryBelowData:=True
'    Range("A1").Select
'    ActiveWorkbook.Save
'    Workbooks("VoIP Billing Report.xls").Close SaveChanges:=False
'End Sub

Hi

Your post does not abide by forum rule 2

Don't post a question in the thread of another member -- start your own. If you feel it's particularly relevant, provide a link to the other thread.

Can you please start your own thread, and reference this one.

rylo