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]

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



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

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

Sorry typo it should be wkbk.Activate and you are correct re Exit Sub.

I appreciate your perseverance!

The only residual problem I have is ... if there is no "Other Income" in any month it stops rather than jump over to loop 3 ... is there any way around this?

Cheers

 

[johnnyL]

How about this:

Sub CopyPasteDataV2()

'   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 rw              As Long
    Dim cell1           As Range, cell2         As Range
    Dim IntervalType    As String
    Dim MsgBoxString    As String
    Dim SearchValue1    As String, SearchValue2 As String
    Dim wbSource        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
            wbSource = wkbk.Name
            Workbooks(wbSource).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
'
'----------------------------------------------------------------------------------------------------------------------------------
'
'
        Workbooks(wbSource).Activate
'
        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
            GoTo GetNextCategory
        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.
'
GetNextCategory:
    Next
'
    Columns("A:I").AutoFit                                                                      ' Fit data in columns.
End Sub

 

[KiwiGrue]

How about this:

Sub CopyPasteDataV2()

'   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 rw              As Long
    Dim cell1           As Range, cell2         As Range
    Dim IntervalType    As String
    Dim MsgBoxString    As String
    Dim SearchValue1    As String, SearchValue2 As String
    Dim wbSource        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
            wbSource = wkbk.Name
            Workbooks(wbSource).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
'
'----------------------------------------------------------------------------------------------------------------------------------
'
'
        Workbooks(wbSource).Activate
'
        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
            GoTo GetNextCategory
        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.
'
GetNextCategory:
    Next
'
    Columns("A:I").AutoFit                                                                      ' Fit data in columns.
End Sub

Brilliant this works very well.

Fantastic ... many thanks for your perseverance and determined assistance to resolve my queries!

Cheers

 

[johnnyL]

Glad to help @KiwiGrue. Perhaps you might mark my previous post as the solution, instead of your post that acknowledges my previous post that worked for a solution.

 

[KiwiGrue]

Done!

 

[johnnyL]

Let us know if you need anything else @KiwiGrue.