VBA to create new tables below existing table depending on variables

[pscofe]

Hi, so I have the table below which will change daily:

local_acc_no	closing_balance	currency	closing_balance_eur	stmt_date	FEED_TYPE	balance	DayCount	Team	Comments
Paul	-3,830,439.00​	JPY	-32,700.77​	15/04/2020 00:00:00	STM	43,597,701.00​	1​	A	Expense
Jack	-2,248,520.60​	IDR	-132.17​	15/04/2020 00:00:00	STM	-2,248,520.60​	3​	B	Expense
Chris	-1,713,448.18​	USD	-1,571,250.05​	15/04/2020 00:00:00	STM	10,330,502.38​	2​	A	Expense
John	-1,163,793.13​	USD	-1,067,210.57​	15/04/2020 00:00:00	STM	251,530.81​	1​	A	Expense
Steven	-919,493.09​	USD	-843,184.86​	15/04/2020 00:00:00	STM	337,087.79​	2​	B	Expense
Marianne	-6,568.79​	EUR	-6,568.79​	15/04/2020 00:00:00	STM	13,018,289.65​	2​	B	Expense
Mary	-69.80​	RON	-14.44​	15/04/2020 00:00:00	STM	-69.80​	5​	A	Write off
Jane	-36.92​	EUR	-36.92​	15/04/2020 00:00:00	STM	0.00​	31​	A	Write off
Julia	-4.00​	ISK	-0.03​	15/04/2020 00:00:00	STM	0.00​	34​	C	Write off
Tony	-1.00​	JPY	-0.01​	15/04/2020 00:00:00	STM	0.00​	5​	C	Write off
Harry	-0.54​	CHF	-0.51​	15/04/2020 00:00:00	STM	-0.54​	29​	A	Write off
Sebastian	-0.36​	NOK	-0.03​	15/04/2020 00:00:00	STM	0.05​	1​	C	Write off
Nicola	-0.31​	SEK	-0.03​	15/04/2020 00:00:00	STM	-0.31​	5​	A	Write off

I need a VBA code to put into a macro:

I want to keep that table where it is but two lines below, to have the headings and all the Team A together. Then a table two lines below that one, with headings and Team B. Etc.

local_acc_no	closing_balance	currency	closing_balance_eur	stmt_date	FEED_TYPE	balance	DayCount	Team	Comments
Paul	-3,830,439.00​	JPY	-32,700.77​	15/04/2020 00:00:00	STM	43,597,701.00​	1​	A	Expense
Chris	-1,713,448.18​	USD	-1,571,250.05​	15/04/2020 00:00:00	STM	10,330,502.38​	2​	A	Expense
John	-1,163,793.13​	USD	-1,067,210.57​	15/04/2020 00:00:00	STM	251,530.81​	1​	A	Expense

local_acc_no	closing_balance	currency	closing_balance_eur	stmt_date	FEED_TYPE	balance	DayCount	Team	Comments
Jack	-2,248,520.60​	IDR	-132.17​	15/04/2020 00:00:00	STM	-2,248,520.60​	3​	B	Expense
Steven	-919,493.09​	USD	-843,184.86​	15/04/2020 00:00:00	STM	337,087.79​	2​	B	Expense
Marianne	-6,568.79​	EUR	-6,568.79​	15/04/2020 00:00:00	STM	13,018,289.65​	2​	B	Expense

Also, anyway I can change the date to get rid of the 00:00:00?

Really appreciate the help!
Thanks,
P

 

[mumps]

Try:

Sub Test()
    Application.ScreenUpdating = False
    Dim LastRow As Long, team As Range, rngList As Object, key As Variant
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Set rngList = CreateObject("Scripting.Dictionary")
    For Each team In Range("I2:I" & LastRow)
        If Not rngList.Exists(team.Value) Then
            rngList.Add team.Value, Nothing
        End If
    Next team
    For Each key In rngList
        Cells(1, 1).CurrentRegion.AutoFilter 9, key
        ActiveSheet.AutoFilter.Range.Copy Cells(Rows.Count, "A").End(xlUp).Offset(3)
    Next key
    Range("A1").AutoFilter
    Application.ScreenUpdating = True
End Sub

 

[pscofe]

wow! Yes that's worked! Unbelievable

If i want to amend the Team to something different (so instead of A, B and C) where do I do that in the code? They're more likely to be something like OPS, Middle Office etc
is there a quick way to format the date as well?
Thank you so much, amazing

 

[pscofe]

the code itself works on anything I put in column I and separates it, just tried it. That's incredible! haha

If can get the date sorted then i have the perfect report! Thanks

 

[mumps]

You are very welcome.
If you amend the Team, the code will work as is. Select the date column and format it as "Date". Unfortunately, you won't see a change in the existing dates. You will have to re-enter them to see the change. Any new dates in that column will appear without the time.

 

[pscofe]

You are very welcome.
If you amend the Team, the code will work as is. Select the date column and format it as "Date". Unfortunately, you won't see a change in the existing dates. You will have to re-enter them to see the change. Any new dates in that column will appear without the time.

cool, that code is fantastic! thanks again

 

[mumps]

My pleasure.

 

[pscofe]

Hello,

You kindly sent me below which was looking at Column I and collating different teams into their own tables....if you remember?!?! I've had to add Column J into the table but it's strange that it goes days without working and then randomly works. I suspect it's how i've created the table itself (from another macro) but is there anything you can think of why it's not working all the time and if easy to fix? Really appreciate any help if poss.

Sub team()

Application.ScreenUpdating = False
Dim LastRow As Long, team As Range, rngList As Object, key As Variant
LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Set rngList = CreateObject("Scripting.Dictionary")
For Each team In Range("I2:I" & LastRow)
If Not rngList.Exists(team.Value) Then
rngList.Add team.Value, Nothing
End If
Next team
For Each key In rngList
Cells(1, 1).CurrentRegion.AutoFilter 9, key
ActiveSheet.AutoFilter.Range.Copy Cells(Rows.Count, "A").End(xlUp).Offset(3)
Next key
Range("A1").AutoFilter
Application.ScreenUpdating = True
End Sub

Initial table

Fund	Custody Bal	Currency	EUR Equiv	Date	Feed type	Bluebay Bal	DayCount	Team	Comments
John	-8,704,731.42	GBP	-9,740,791.19	19/05/2020 00:00:00	Stmt Ccy Message	2,961,898.78	4	A	Chased
Terry	-2,061,400.19	NZD	-1,149,281.21	19/05/2020 00:00:00	Stmt Ccy Message	36,621.57	4	B	Fx
Antonia	-1,181,792.59	GBP	-1,322,452.62	19/05/2020 00:00:00	Stmt Ccy Message	625,207.41	4	B	Fx
marianne	-1,018,429.26	MXN	-39,472.37	19/05/2020 00:00:00	Stmt Ccy Message	117,962.62	4	B	Fx
Sebastian	-83,905.52	EUR	-83,905.52	19/05/2020 00:00:00	Stmt Ccy Message	95,799.47	1	C	break
keith	-44,497.53	GBP	-49,793.74	19/05/2020 00:00:00	Stmt Ccy Message	595,117.40	5	C	break
Malcolm	-4,720.16	EUR	-4,720.16	19/05/2020 00:00:00	Stmt Ccy Message	8,770.53	1	C	break
Pierre	-41.05	PEN	-10.94	19/05/2020 00:00:00	Stmt Ccy Message	-41.05	18	C	write off
Arif	-4.00	ISK	-0.03	19/05/2020 00:00:00	Stmt Ccy Message	0.00	51	C	write off
Helena	-0.16	CZK	-0.01	19/05/2020 00:00:00	Stmt Ccy Message	-0.16	2	C	write off
Bard	-0.09	NOK	-0.01	19/05/2020 00:00:00	Stmt Ccy Message	-0.40	4	C	write off

But then writes over the data instead of dropping down into new tables:

Fund	Custody Bal	Currency	EUR Equiv	Date	Feed type	Bluebay Bal	DayCount	Team	Comments
John	-8,704,731.42	GBP	-9,740,791.19	19/05/2020 00:00:00	Stmt Ccy Message	2,961,898.78	4	A	Chased
Terry	-2,061,400.19	NZD	-1,149,281.21	19/05/2020 00:00:00	Stmt Ccy Message	36,621.57	4	B	Fx
Antonia	-1,181,792.59	GBP	-1,322,452.62	19/05/2020 00:00:00	Stmt Ccy Message	625,207.41	4	B	Fx
Fund	Custody Bal	Currency	EUR Equiv	Date	Feed type	Bluebay Bal	DayCount	Team	Comments
John	-8,704,731.42	GBP	-9,740,791.19	19/05/2020 00:00:00	Stmt Ccy Message	2,961,898.78	4	A	Chased
Fund	Custody Bal	Currency	EUR Equiv	Date	Feed type	Bluebay Bal	DayCount	Team	Comments
Terry	-2,061,400.19	NZD	-1,149,281.21	19/05/2020 00:00:00	Stmt Ccy Message	36,621.57	4	B	Fx
Antonia	-1,181,792.59	GBP	-1,322,452.62	19/05/2020 00:00:00	Stmt Ccy Message	625,207.41	4	B	Fx
Arif	-4.00	ISK	-0.03	19/05/2020 00:00:00	Stmt Ccy Message	0.00	51	C	write off
Helena	-0.16	CZK	-0.01	19/05/2020 00:00:00	Stmt Ccy Message	-0.16	2	C	write off
Bard	-0.09	NOK	-0.01	19/05/2020 00:00:00	Stmt Ccy Message	-0.40	4	C	write off
Fund	Custody Bal	Currency	EUR Equiv	Date	Feed type	Bluebay Bal	DayCount	Team	Comments
Arif	-4.00	ISK	-0.03	19/05/2020 00:00:00	Stmt Ccy Message	0.00	51	C	write off
Helena	-0.16	CZK	-0.01	19/05/2020 00:00:00	Stmt Ccy Message	-0.16	2	C	write off
Bard	-0.09	NOK	-0.01	19/05/2020 00:00:00	Stmt Ccy Message	-0.40	4	C	write off

 

[mumps]

Try:

Sub team()
    Application.ScreenUpdating = False
    Dim LastRow As Long, team As Range, rngList As Object, key As Variant
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Set rngList = CreateObject("Scripting.Dictionary")
    For Each team In Range("I2:I" & LastRow)
        If Not rngList.Exists(team.Value) Then
            rngList.Add team.Value, Nothing
        End If
    Next team
    For Each key In rngList
        LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        Cells(1, 1).CurrentRegion.AutoFilter 9, key
        ActiveSheet.AutoFilter.Range.Copy Cells(LastRow + 3, 1)
    Next key
    Range("A1").AutoFilter
    Application.ScreenUpdating = True
End Sub

 

[pscofe]

Fantastic, it's working again !! Thanks for your help!