VBA MAcro to split down billing report

[F1-Junkie]

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.)

A

B

C

D

E

F

G

H

I

J

K

L

1

Date

Calling From

From

Calling To

To

Type

Name

Group

Usage Seconds

Usage Bytes

Usage Text

Amount

2

​ 19/12/2016 15:59 <tbody> </tbody>

4470070000004

GB

X

Call received

Alan N

Location 2

60

0

0

0

<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:

A

B

cC

D

E

F

G

H

I

J

K

L

1

Name

Date

Calling From

From

Calling To

To

Type

Group

Usage Seconds

Usage Bytes

Usage Text

Amount

2

spare spare

19/12/2016 23:58

GB

447007000000

X

Call made

Location 1

34

0

0

0.0816

3

spare spare

19/12/2016 23:57

GB

447007000000

X

Call made

Location 1

30

0

0

0.072

4

Alan B

19/12/2016 23:51

447001000000

US

X

Call received

Location 2

60

0

0

0

5

Dave G

19/12/2016 23:30

447004000000

GB

X

Call received

Location 2

300

0

0

0

6

Dave G

19/12/2016 23:10

GB

447003000000

X

Call made

Location 2

237

0

0

0.5688

7

Dave G

19/12/2016 23:09

GB

447003000000

X

Call made

Location 2

34

0

0

0.0816

8

Dave G

19/12/2016 23:03

GB

447003000000

X

Call made

Location 2

157

0

0

0.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

 

[texasalynn]

why not use a pivot table? Then you would get the individual totals

 

[F1-Junkie]

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]

here is a macro that will breakout each unique item in column A

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