Reuse VBA Code with other variables

[KiwiGrue]

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

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

 

[KiwiGrue]

After a night of sleep. Let's try this one more time.

Since you want to open all of the files, I need to have a way to determine which type of P&L is opened.

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

So does the 'Trading Income' Heading appear in the same cell that 'Other Income', Cost of Sales', & 'Operating Expenses' appear on in the other files?

We need some way to identify which file has been opened, so the corresponding variables can be set.

Maybe you have an idea that could distinguish which file has been opened.

Okay thank you ... but the types of P&L are NOT files rather they are categories embedded in the source file ... see attached example files (source and target). I only want to open one source workbook per month but there may be slight variations in the source workbook name hence using the wildcards.

Physio_Form_Limited_-_Profit_and_Loss August 2021.xlsx
	E
39
Profit and Loss

Financial Performance.xlsx
	D
6
Sheet1

I do not have any issues with extracting data from the source workbook and pasting it to the target workbook (although the code could probably be smarter) after checking that the date of the data for the source workbook is the next month to the last date in column A in the Target workbook.

The way I have done the copy paste is via four sub-routines that essentially use the same code requiring the input of the date of the data month each time.

I was trying to (1). identify a more effective and efficient way of using the core code once to identify the range for each P&L category in the source workbook sequentially. (2). Avoiding the need to seek date input from the user multiple times (after researching on the web I was not able to establish how to pass the date variable across multiple sub-routines).

So presently the first sub-routine establishes the range for Trading Income then copies/paste this data to the Target workbook with column A being date of the month (from user input), Column B P&L sub-category, Column C P&L Category and finally Column D the dollar value. The range for each P&L category may vary from month to month. The query I have ... is it possible to use the core code and substitute Trading Income/Total Training Income with the other P&L categories sequentially using the core code rather than multiple sub-routines?

I included code for the Trading Income sub-routine and Other Income earlier.

I hope this is clearer.

Cheers

 

[johnnyL]

So all 4 categories are in one source file?

 

[johnnyL]

If they are all in the same workbook, are all the categories on 1 sheet or are they on separate sheets in the workbook.

 

[KiwiGrue]

All categories are on sheet 1 of the source workbook column A

 

[johnnyL]

I am not able to test but see how the following does:

Sub CopyPasteData()

'   Extract data from monthly P&L account and paste in Master data document.
'
    Dim Checkdate       As Date, Enddate        As Date, Startdate    As Date
    Dim CategoryLoop    As Long
    Dim lrTarget        As Long
    Dim IntervalType    As String
    Dim MsgBoxString    As String
    Dim SearchValue1    As String, SearchValue2 As String
    Dim dataBook        As Workbook, wkbk       As Workbook
'
'   Check the last month data was pasted in the Master Data Workbook.
'
    IntervalType = "m"                                                                              ' Specifies "m" as month interval.
'
'   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 dataBook = Workbooks("Financial Performance.xlsm")                                          ' Set workbook to destination workbook to paste information.
    dataBook.Activate
'
    lrTarget = Cells.Find("*", Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False).Row    ' Finds last cell with data.
'
    Enddate = Cells(lrTarget, 1).Value                                                              ' Date in last cell of Master Data workbook.
    Checkdate = DateAdd(IntervalType, 1, Enddate)                                                   ' Calculate the date for the next month to insert data.
'
    If Checkdate = Startdate Then

    Else
        MsgBox ("WARNING: The data is not for the next month!")
    End If
'
'----------------------------------------------------------------------------------------------------------------------------------
'
    For Each wkbk In Workbooks                                                                      ' Set workbook to source of financial data.
        If wkbk.Name Like "*Form_Limited*Profit_and_Loss*" Then
            Workbooks(wkbk.Name).Activate
            Exit For
        End If
    Next wkbk
'
'----------------------------------------------------------------------------------------------------------------------------------
'
    For CategoryLoop = 1 To 4
        Select Case CategoryLoop
            Case Is = 1
                SearchValue1 = "Trading Income"
                SearchValue2 = "Total Trading Income"
                MsgBoxString = "No P&L data for this category this month"
            Case Is = 2
                SearchValue1 = "Other Income"
                SearchValue2 = "Total Other Income"
                MsgBoxString = "No Other Income this month"
            Case Is = 3
                SearchValue1 = "Cost of Sales"
                SearchValue2 = "Total Cost of Sales"
                MsgBoxString = "No Cost of Sales this month"
            Case Is = 4
                SearchValue1 = "Operating Expenses"
                SearchValue2 = "Total Operating Expenses"
                MsgBoxString = "No Operating Expenses this month"
        End Select
'
'----------------------------------------------------------------------------------------------------------------------------------
'
        Dim rw      As Long
        Dim cell1   As Range, cell2     As Range
'
        Set cell1 = Range("A:A").Find(SearchValue1, LookAt:=xlWhole)                    ' Find start cell and end cell of P&L type to establish range to copy.
'
        If Not cell1 Is Nothing Then
            Set cell1 = Range("A:A").Find(SearchValue1, LookAt:=xlWhole).Offset(1, 0)
            Set cell2 = Range("A:A").Find(SearchValue2, LookAt:=xlWhole).Offset(-1, 0)
        Else
            MsgBox MsgBoxString
            Exit Sub
        End If
'
        Range(cell1, cell2).Copy                                                                        ' Copy data.
'
        rw = Range(cell1, cell2).Count                                                                  ' Count number of rows with data in them to copy.
'
        dataBook.Activate
'
        lrTarget = Cells.Find("*", Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False).Row    ' Finds first empty cell to insert data.
'
        Cells(lrTarget + 1, 2).Select                                                                   ' Select cell to insert P&L item.
        ActiveSheet.Paste
'
        Range(cell1.Offset(0, 1), cell2.Offset(0, 1)).Copy
'
        Cells(lrTarget + 1, 4).Select
        ActiveSheet.Paste
'
        Range(Cells(lrTarget + 1, 1), Cells(lrTarget + rw, 1)).Value = Startdate                ' Copy month into column A and set format as dd/mmm/yyyy.
        Columns("A").NumberFormat = "dd-mmm-yyyy"
'
        Range(Cells(lrTarget + 1, 3), Cells(lrTarget + rw, 3)).Value = SearchValue1             ' Copy P&L category into column C.
'
    Next
'
    Columns("A:I").AutoFit                                                                      ' Fit data in columns.
End Sub

 

[KiwiGrue]

I am not able to test but see how the following does:

Sub CopyPasteData()

'   Extract data from monthly P&L account and paste in Master data document.
'
    Dim Checkdate       As Date, Enddate        As Date, Startdate    As Date
    Dim CategoryLoop    As Long
    Dim lrTarget        As Long
    Dim IntervalType    As String
    Dim MsgBoxString    As String
    Dim SearchValue1    As String, SearchValue2 As String
    Dim dataBook        As Workbook, wkbk       As Workbook
'
'   Check the last month data was pasted in the Master Data Workbook.
'
    IntervalType = "m"                                                                              ' Specifies "m" as month interval.
'
'   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 dataBook = Workbooks("Financial Performance.xlsm")                                          ' Set workbook to destination workbook to paste information.
    dataBook.Activate
'
    lrTarget = Cells.Find("*", Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False).Row    ' Finds last cell with data.
'
    Enddate = Cells(lrTarget, 1).Value                                                              ' Date in last cell of Master Data workbook.
    Checkdate = DateAdd(IntervalType, 1, Enddate)                                                   ' Calculate the date for the next month to insert data.
'
    If Checkdate = Startdate Then

    Else
        MsgBox ("WARNING: The data is not for the next month!")
    End If
'
'----------------------------------------------------------------------------------------------------------------------------------
'
    For Each wkbk In Workbooks                                                                      ' Set workbook to source of financial data.
        If wkbk.Name Like "*Form_Limited*Profit_and_Loss*" Then
            Workbooks(wkbk.Name).Activate
            Exit For
        End If
    Next wkbk
'
'----------------------------------------------------------------------------------------------------------------------------------
'
    For CategoryLoop = 1 To 4
        Select Case CategoryLoop
            Case Is = 1
                SearchValue1 = "Trading Income"
                SearchValue2 = "Total Trading Income"
                MsgBoxString = "No P&L data for this category this month"
            Case Is = 2
                SearchValue1 = "Other Income"
                SearchValue2 = "Total Other Income"
                MsgBoxString = "No Other Income this month"
            Case Is = 3
                SearchValue1 = "Cost of Sales"
                SearchValue2 = "Total Cost of Sales"
                MsgBoxString = "No Cost of Sales this month"
            Case Is = 4
                SearchValue1 = "Operating Expenses"
                SearchValue2 = "Total Operating Expenses"
                MsgBoxString = "No Operating Expenses this month"
        End Select
'
'----------------------------------------------------------------------------------------------------------------------------------
'
        Dim rw      As Long
        Dim cell1   As Range, cell2     As Range
'
        Set cell1 = Range("A:A").Find(SearchValue1, LookAt:=xlWhole)                    ' Find start cell and end cell of P&L type to establish range to copy.
'
        If Not cell1 Is Nothing Then
            Set cell1 = Range("A:A").Find(SearchValue1, LookAt:=xlWhole).Offset(1, 0)
            Set cell2 = Range("A:A").Find(SearchValue2, LookAt:=xlWhole).Offset(-1, 0)
        Else
            MsgBox MsgBoxString
            Exit Sub
        End If
'
        Range(cell1, cell2).Copy                                                                        ' Copy data.
'
        rw = Range(cell1, cell2).Count                                                                  ' Count number of rows with data in them to copy.
'
        dataBook.Activate
'
        lrTarget = Cells.Find("*", Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False).Row    ' Finds first empty cell to insert data.
'
        Cells(lrTarget + 1, 2).Select                                                                   ' Select cell to insert P&L item.
        ActiveSheet.Paste
'
        Range(cell1.Offset(0, 1), cell2.Offset(0, 1)).Copy
'
        Cells(lrTarget + 1, 4).Select
        ActiveSheet.Paste
'
        Range(Cells(lrTarget + 1, 1), Cells(lrTarget + rw, 1)).Value = Startdate                ' Copy month into column A and set format as dd/mmm/yyyy.
        Columns("A").NumberFormat = "dd-mmm-yyyy"
'
        Range(Cells(lrTarget + 1, 3), Cells(lrTarget + rw, 3)).Value = SearchValue1             ' Copy P&L category into column C.
'
    Next
'
    Columns("A:I").AutoFit                                                                      ' Fit data in columns.
End Sub

Ah ... fantastic ... the For CategoryLoop 1 To 4 is exactly what I am looking for!

The code is fine for the first iteration "Trading Income" and the second iteration recognises "Other Income" but it fails I think because the variables:

Dim rw As Long
Dim cell1 As Range, cell2 As Range

still hold their previous values ... do these need to be reset to zero at the end of the loop before ... End?

Cheers

 

[johnnyL]

As I mentioned, I couldn't test it. Lemme have another look see at the code and I will report back.

 

[KiwiGrue]

As I mentioned, I couldn't test it. Lemme have another look see at the code and I will report back.

It seems to be working now once I insert ... wktk.activate ... prior to:

Set cell1 = Range("A:A").Find(SearchValue1, LookAt:=xlWhole) ' Find start cell and end cell of P&L type to establish range to copy.
'
If Not cell1 Is Nothing Then
Set cell1 = Range("A:A").Find(SearchValue1, LookAt:=xlWhole).Offset(1, 0)
Set cell2 = Range("A:A").Find(SearchValue2, LookAt:=xlWhole).Offset(-1, 0)
Else
MsgBox MsgBoxString
Exit Sub
End If

 

[KiwiGrue]

It seems to be working now once I insert ... wktk.activate ... prior to:

Set cell1 = Range("A:A").Find(SearchValue1, LookAt:=xlWhole) ' Find start cell and end cell of P&L type to establish range to copy.
'
If Not cell1 Is Nothing Then
Set cell1 = Range("A:A").Find(SearchValue1, LookAt:=xlWhole).Offset(1, 0)
Set cell2 = Range("A:A").Find(SearchValue2, LookAt:=xlWhole).Offset(-1, 0)
Else
MsgBox MsgBoxString
Exit Sub
End If

I added an Exit Sub after the MsgBox MsgBoxString also but this does not help if there is no "Other Income" in any month. Is there anyway to 'jump' over Loop 2 if the is no "Other Income"?

 

[johnnyL]

I added an Exit Sub after the MsgBox MsgBoxString also.

You are losing me again. There is already an 'Exit Sub' there.

It seems to be working now once I insert ... wktk.activate ... prior to:

Set cell1 = Range("A:A").Find(SearchValue1, LookAt:=xlWhole) ' Find start cell and end cell of P&L type to establish range to copy.
'
If Not cell1 Is Nothing Then
Set cell1 = Range("A:A").Find(SearchValue1, LookAt:=xlWhole).Offset(1, 0)
Set cell2 = Range("A:A").Find(SearchValue2, LookAt:=xlWhole).Offset(-1, 0)
Else
MsgBox MsgBoxString
Exit Sub
End If

I don't know what 'wktk.activate' is either.

However, if you have it working now, that was the goal!