VBA Help - Extract columns to a new sheet based on a list of Account numbers

shynot

New Member
Joined
Mar 9, 2021
Messages
3
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
Hi all,

I'd like to do the following via a Macro, but am unsure of how/what the code should look like. I have a list of accounts with their related account numbers in Sheet 1, and a list of transactions in Sheet 2 with other details such as date, reference, etc.

What I'd like the Macro to do is to loop through the list of account numbers from Sheet 1, filter and extract the relevant columns from Sheet 2, and copy / paste those columns in Sheet 3. Ideally this would be a loop with the account details being pasted one below the other in sequence in Sheet 3.

I've been able to write simple VBA code to do this for one account number, and doesn't work with the second onwards. I apologise if this is not clear enough as I'm just starting out at VBA coding. Would be grateful for any and all help!
 

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,620
Office Version
  1. 2007
Platform
  1. Windows
Hi and welcome to MrExcel.
Could you put some examples
 

shynot

New Member
Joined
Mar 9, 2021
Messages
3
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
Hi Dante,

So in Sheet 1, I'll have the following details (Example):

AB
1Account no.Account name
212345Tax
323456Salaries

And in Sheet 2, I'll have the following details:

ABCDE
1Account no.ReferenceTypeDateAmount
212345Tax - JanAC1/1/2150
312345Tax - FebAC1/2/2150
467890OthersAC1/1/21100
523456Salaries - JanAC1/1/2150
623456Salaries - FebAC1/2/2150
745678OthersAC1/1/21100

So ideally in Sheet 3, I'd have the macro filter and copy Sheet 2, and output the following details using the account numbers in Row A from Sheet 1:

ABCD
112345Tax
2Tax - Jan1/1/2150
3Tax - Feb1/2/2150
4
523456Salaries
6Salaries - Jan1/1/2150
7Salaries - Feb1/2/21100

I realise the reason my macro doesn't work as how I intended it is because it has hard-coded values and not variables. Ie. Autofilter variable is "123456" as opposed to Cell A2. Hope this is clear. Thank you
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,620
Office Version
  1. 2007
Platform
  1. Windows
Try this:

VBA Code:
Sub Extract_columns()
  Dim a As Variant, b As Variant
  Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
  Dim i As Long, k As Long, lr As Long
  Dim c As Range, f As Range
  
  Application.ScreenUpdating = False
  Set sh1 = Sheets("Sheet1")
  Set sh2 = Sheets("Sheet2")
  Set sh3 = Sheets("Sheet3")
  
  a = sh1.Range("A2", sh1.Range("B" & Rows.Count).End(3)).Value2
  b = sh2.Range("A2", sh2.Range("E" & Rows.Count).End(3)).Value2
  
  If sh2.AutoFilterMode Then sh2.AutoFilterMode = False
  lr = sh2.Range("A" & Rows.Count).End(3).Row
  sh3.Rows("2:" & Rows.Count).ClearContents
  
  k = 2
  For i = 1 To UBound(a, 1)
    If sh2.AutoFilterMode Then sh2.AutoFilterMode = False
    Set f = sh2.Range("A:A").Find(a(i, 1), , xlValues, xlWhole, , , False)
    If Not f Is Nothing Then
      sh3.Range("A" & k).Resize(1, 2).Value = Array(a(i, 1), a(i, 2))
      k = k + 1
      sh2.Range("A1").AutoFilter 1, a(i, 1)
      sh2.AutoFilter.Range.Range("B2:B" & lr & ",D2:E" & lr).Copy sh3.Range("B" & k)
      k = sh3.Range("B" & Rows.Count).End(3).Row + 2
    End If
  Next
  
  If sh2.AutoFilterMode Then sh2.AutoFilterMode = False
  Application.ScreenUpdating = True
End Sub
 

shynot

New Member
Joined
Mar 9, 2021
Messages
3
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
Hi Dante,

With a bit of tweaking, it works a treat! Thanks so much for the help :biggrin:
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,620
Office Version
  1. 2007
Platform
  1. Windows
I'm glad to help you. Thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,129,574
Messages
5,637,162
Members
416,959
Latest member
Mohzein

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