VBA MAcro to split down billing report

F1-Junkie

New Member
Joined
Feb 21, 2013
Messages
5
Hi there

Every month I get a billing csv for our company mobiles. This is initially indexed by Column A (Date) with the Users name in Column G. Each row details a specific action for that user (either call in, call out, SMS, data usage etc.)

ABCDEFGHIJKL
1DateCalling FromFromCalling ToToTypeNameGroupUsage SecondsUsage BytesUsage TextAmount
2

19/12/2016 15:59

<tbody>
</tbody>
4470070000004GBXCall receivedAlan NLocation 260000

<colgroup><col width="64" span="12" style="width:48pt"></colgroup> <tbody>
</tbody>


I cut Column G and insert it in Column A shifting the rest across:

ABcCDEFGHIJKL
1NameDateCalling FromFromCalling ToToTypeGroupUsage SecondsUsage BytesUsage TextAmount
2spare spare19/12/2016 23:58GB447007000000XCall madeLocation 134000.0816
3spare spare19/12/2016 23:57GB447007000000XCall madeLocation 130000.072
4Alan B19/12/2016 23:51447001000000USXCall receivedLocation 260000
5Dave G19/12/2016 23:30447004000000GBXCall receivedLocation 2300000
6Dave G19/12/2016 23:10GB447003000000XCall madeLocation 2237000.5688
7Dave G19/12/2016 23:09GB447003000000XCall madeLocation 234000.0816
8Dave G19/12/2016 23:03GB447003000000XCall madeLocation 2157000.3768

<colgroup><col><col><col><col><col><col><col span="6"></colgroup><tbody>
</tbody>

Currently this is being sorted (manually) by column A (Users name) and then sub sorted by Column B (Date and time) to form an individual Bill per user in date & time order (oldest to newest).

Row 1 has the column headers which is copied to Sheet 2 row 1 along with the data for that user, Column L is totaled then saved as a single sheet as that users name (originating from Column A).

The rows for that users data (rows 2 thru x) are then deleted and the process done again until all the individual bills are done.

I have seen some VBA on here to do it based on a cells value with that value being hard coded in to the VBA, but I don't particularly want to write / use a separate one for each user name especially as phone owners change through the business - and there are 145 mobiles in the business. :(

Any help in automating this would be great (I have asked the mobile company for individual bills, but they have refused :( )

Thanks in advance for any help!!

F1-Junkie
 

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple

texasalynn

Well-known Member
Joined
May 19, 2002
Messages
8,458
why not use a pivot table? Then you would get the individual totals
 

F1-Junkie

New Member
Joined
Feb 21, 2013
Messages
5
I may have left out the bit where the individual bills (per user sheet) are then emailed to the individuals manager and the individual. It's not just about getting the totals. Sorry.
 

texasalynn

Well-known Member
Joined
May 19, 2002
Messages
8,458
here is a macro that will breakout each unique item in column A
Code:
Sub breakout_group()
Dim LR As Long, LC As Long, x As Long
Dim rng As Range, Rng1 As Range, Rng2 As Range, Rng3 As Range
Dim ws As String
Dim AreaArray, fn As WorksheetFunction
LR = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
LC = ActiveSheet.Range("IV1").End(xlToLeft).Column + 1
ws = ActiveSheet.Name
Set fn = Application.WorksheetFunction
With Sheets(ws)
    Set rng = .UsedRange
    .Range("A:A").AdvancedFilter Action:=xlFilterCopy, _
            CopyToRange:=.Cells(1, LC + 2), Unique:=True
    Set Rng2 = Intersect(.Columns(LC + 2).CurrentRegion, _
            .Rows("1:" & Rows.Count))
    ReDim AreaArray(1 To Rng2.Cells.Count)
    AreaArray = fn.Transpose(Rng2)
    .Columns(LC + 2).Clear
For x = LBound(AreaArray) To UBound(AreaArray)
    If x <> 1 Then
        rng.AutoFilter Field:=1, Criteria1:=AreaArray(x)
        Set Rng3 = Intersect(rng, .Cells.SpecialCells(xlCellTypeVisible))
        Rng3.Copy Destination:=Cells(1, LC)
        Rng3.Clear
        rng.AutoFilter
        LC = ActiveSheet.Range("IV2").End(xlToLeft).Column + 1
    End If
Next x
rng.AutoFilter
End With
Rows("1:1").EntireRow.Insert
Cells(1, 2).NumberFormat = "General"
Cells(1, 2).Formula = "=countA(" & Range(Cells(2, "B"), Cells(LR, "B")).Address(False, False) & ")"
Cells(1, 2).Copy Destination:=Range(Cells(1, "B"), Cells(1, LC - 1))
    Application.Calculate
    
MsgBox "Done"
End Sub
 

Forum statistics

Threads
1,148,145
Messages
5,745,049
Members
423,917
Latest member
Frank1931

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top