Reuse VBA Code with other variables

KiwiGrue

New Member
Joined
Oct 24, 2021
Messages
25
Office Version
  1. 365
Platform
  1. MacOS
I have developed some vba code to extract monthly financial data from one workbook to copy to another checking that the date of the data is the next (and valid) month. I have multiple sub routines to achieve this but I am struggling to tidy up the code and reuse it rather than have several subs.

The Profit & Loss variables are:

1. Trading Income/Total Trading Income
2. Other Income/Total Other Income
3. Cost of Sales/Total Cost of Sales
4 Operating Expenses/Total Operating Expenses

The P&L categories and sub-categories may vary from month to month.

The sub routine for Trading Income/Total Trading Income is attached below - how do I reuse the code efficiently to work through the 4 categories sequentially?

I am new to VBA so any insights or assistance would be appreciated.

Cheers


VBA Code:
Sub CopyPasteTradingIncomeData()

'Extract data from monthly P&L account and paste in Master data document.
Dim wkbk As Workbook
Dim dataBook As Workbook
Dim cell1 As Range
Dim cell2 As Range
Dim rw As Integer
Dim Startdate As Date
Dim Enddate As Date
Dim Checkdate As Date
Dim IrTarget As String
Dim IntervalType As String

'Check the last month data was pasted in the Master Data Workbook.

'Specifies "m" as month interval.
IntervalType = "m"

'Ask user to input month of data to be pasted to the Master data workbook
Startdate = InputBox("Enter month ending for P&L data to be pasted in Master Data workbook - Format dd/mm/yyyy", "Information Month Ending")

'Set workbook to destination workbook to paste information.
Set dataBook = Workbooks("Financial Performance.xlsm")
dataBook.Activate

'Finds last cell with data.
lrTarget = Cells.Find("*", Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False).Row

'Date in last cell of Master Data workbook.
Enddate = Cells(lrTarget, 1).Value

'Calculate the date for the next month to insert data.
Checkdate = DateAdd("m", 1, Enddate)
  
    If Checkdate = Startdate Then

    Else

    MsgBox ("WARNING: The data is not for the next month!")
   
    End If
   
'Set workbook to source of financial data.
For Each wkbk In Workbooks
        If wkbk.Name Like "*Form_Limited_-_Profit_and_Loss*" Then
            Workbooks(wkbk.Name).Activate
            Exit For
        End If

Next wkbk

'Find start cell and end cell of P&L type to establish range to copy.
Set cell1 = Range("A:A").Find("Trading Income", lookat:=xlWhole)

    If Not cell1 Is Nothing Then
   
    Set cell1 = Range("A:A").Find("Trading Income", lookat:=xlWhole).Offset(1, 0)
    Set cell2 = Range("A:A").Find("Total Trading Income", lookat:=xlWhole).Offset(-1, 0)
   
    Else: MsgBox ("No P&L data for this category this month")
   
    Exit Sub
   
    End If

'Copy Trading Income data.
Range(cell1, cell2).Copy

'Count number of rows with data in them to copy.
 rw = Range(cell1, cell2).Count

'Set workbook to destination workbook to paste information.
Set dataBook = Workbooks("Financial Performance.xlsm")
dataBook.Activate

'Finds first empty cell to insert data.
lrTarget = Cells.Find("*", Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False).Row

'Select cell to insert P&L item.
Cells(lrTarget + 1, 2).Select
ActiveSheet.Paste

Range(cell1.Offset(0, 1), cell2.Offset(0, 1)).Copy

Cells(lrTarget + 1, 4).Select
ActiveSheet.Paste

'Copy month into column A and set format as dd/mmm/yyyy.
Range(Cells(lrTarget + 1, 1), Cells(lrTarget + rw, 1)).Value = Startdate
Columns("A").NumberFormat = "dd-mmm-yyyy"

'Copy P&L category into columnC.
Range(Cells(lrTarget + 1, 3), Cells(lrTarget + rw, 3)).Value = "Trading Income"

'Fit data in columns.
Columns("A:D").AutoFit


End Sub
 
Last edited by a moderator:

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
Can you post the code for your other sub routines similar to the one you already posted?
 
Upvote 0
Can you post the code for your other sub routines similar to the one you already posted?
Hi Johnny

Here is the code for the Other Income ... please note that I have not changed the code for the workbook where the data is to be extracted but I shall amend it to the earlier code later.

Cheers
Alistair

Sub PasteOtherIncome()

Dim sourceBook As Workbook
Dim dataBook As Workbook
Dim cell1 As Range
Dim cell2 As Range
Dim dte As Date
Dim rw As Integer
Dim rng As Range

'Set workbook to source of financial data.
Set sourceBook = Workbooks("Form_Limited_Profit_and_Loss Month Year.xlsx")
sourceBook.Activate

'Find start cell and end cell of Other Income to establish range to copy.
Set cell1 = Range("A:A").Find("Other Income", lookat:=xlWhole)

If Not cell1 Is Nothing Then

Set cell1 = Range("A:A").Find("Other Income", lookat:=xlWhole).Offset(1, 0)
Set cell2 = Range("A:A").Find("Total Other Income", lookat:=xlWhole).Offset(-1, 0)

Else: MsgBox ("No Other Income this month")

Exit Sub

End If

'Copy Other Income data.
Range(cell1, cell2).Copy

'Count number of rows with data in them to copy.
rw = Range(cell1, cell2).Count

'set workbook to destination workbook to paste information.
Set dataBook = Workbooks("Financial Performance.xlsm")
dataBook.Activate

'Finds first empty cell to insert data.
lrTarget = Cells.Find("*", Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False).Row

'Debug.Print lrTarget

'Select cell to insert P&L item.
Cells(lrTarget + 1, 2).Select
ActiveSheet.Paste

Range(cell1.Offset(0, 1), cell2.Offset(0, 1)).Copy

Cells(lrTarget + 1, 4).Select
ActiveSheet.Paste

'Ask to input the month ending for the financial information.
dte = InputBox("Enter date of month ending", "Data for Month")

'Copy month into column A and set format as dd/mmm/yyyyy.
Range(Cells(lrTarget + 1, 1), Cells(lrTarget + rw, 1)).Value = dte
Columns("A").NumberFormat = "dd-mmm-yyyy"

'Copy P&L category into columnC.
Range(Cells(lrTarget + 1, 3), Cells(lrTarget + rw, 3)).Value = "Other Income"

End Sub
 
Upvote 0
Need to know the name format of your workbook names that you are opening.

Original post has the following code:

VBA Code:
        If wkbk.Name Like "*Form_Limited_-_Profit_and_Loss*" Then

Last code posted has:

VBA Code:
Set sourceBook = Workbooks("Form_Limited_Profit_and_Loss Month Year.xlsx")

So can you post the names of the workbooks involved?
 
Upvote 0
Need to know the name format of your workbook names that you are opening.

Original post has the following code:

VBA Code:
        If wkbk.Name Like "*Form_Limited_-_Profit_and_Loss*" Then

Last code posted has:

VBA Code:
Set sourceBook = Workbooks("Form_Limited_Profit_and_Loss Month Year.xlsx")

So can you post the names of the workbooks involved?
Hi Johnny

The source workbooks vary slightly each month hence the best option is "*Form_Limited_-_Profit_and_Loss*" I am using this code to test variations albeit the standard form will probably be "Form_Limited_-_Profit_and_Loss Month Year.xlsx" format with month (and year) changing each subsequent month.

Cheers
Alistair
 
Upvote 0
Can you please provide the full names?

I need to see what might be in front and back of the file names. We can figure out the in between stuff.
 
Last edited:
Upvote 0
Can you please provide the full names?

I need to see what might be in front and back of the file names.
Source workbook name in full is "Physio_Form_Limited_-_Profit_and_Loss August 2021.xlsx"

Target workbook is "Financial Performance.xlsm"
 
Upvote 0
And the rest of the source file names?
some workbook names do not have "Physio" appended to them and each file name reflects different months eg. April 2021, May 2021, June 2021, July 2021 etc. The workbooks names are not an issue the code selects any open workbook with - ... If wkbk.Name Like "*Form_Limited_-_Profit_and_Loss*" Then ...

The issue I am endeavouring to solve is how to avoid reusing the same code in full multiple times to select the variable ranges for each of the 4 P&L categories (see first post) in sequence.
 
Upvote 0

Forum statistics

Threads
1,223,911
Messages
6,175,325
Members
452,635
Latest member
laura12345

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
Back
Top