Copying data from one Sheet to another Sheet in the same workbook.

[Kayslover]

Hi All,

I am wondering if you can help with the following.

I have a workbook that records weekly Income and Expenses.

Each workbook consists of 4 or 5 sheets that make up the month.

All Income for the week is recorded in Cell A1 to V33 in the appropriate weekly sheet.

All Expenses for the week is recorded in Cell A39 to V59 (Total of 21 rows) in the appropriate weekly sheet. Row 60 in the individual Sheets is a Total Line which has the word “TOTAL” in D60.

Is it possible to have a sheet that will copy all Expenses rows that have input in it from all the Sheet1 thru Sheet5?

Example

If Sheet1 has data in rows 39 and 40, Sheet2 has data in rows 39 to 46, Sheet3 has no data in rows 39 to 59, Sheet4 has data in only row 39 and Sheet5 has data in rows 39 to 65 (this allows for the User to insert extra lines for Expenses as and when required.

Proposed Solution

What I would like is to have a sheet called "Monthly Expenses" to have data from Sheet1, rows 39 and 40, data from Sheet2 rows 39 to 46, nothing from Sheet3 as it has no input, data from Sheet4 row 39 and finally data from Sheet5 rows 39 to 65. Row 1 in Sheet "Monthly Expenses" will have always have headings as those in Row 38 on Sheets1 -Sheets 5.

Row 60 in the individual Sheets is a Total Line which has the word “TOTAL” in D60. This might assist in identifying the range.

Cells C39 to C59, H39 to H59 and I39 to I59 (H and I are merged Cells) have Dropdowns.

Hoping someone can help.

 

[sijpie]

Here is the code you need. Read at least the comments at the top.

The code uses arrays for ultra fast processing. Blink and you will miss it.

To use: Take one of your monthly workbooks. Save as Macro enabled (.xlsm)
in the workbook, press Alt-F8
type x in the box and press the "Create"button. This will open the VBA editor (VBE). Copy the macro shown below, and paste it into the VBE, overwriting the x macro.

Save the workbook.
Then press Alt-F8 again, select the macro and press "Run" (or double click on the macro name)

Option Explicit

Sub ConsolidateExpenses()
' put the expense rows from the week sheets into a new _
  monthly consolidated sheet.
 
' Assumes that the only worksheets in the book are the _
  weekly sheets.
  

    Dim wsWk As Worksheet, wsTot As Worksheet
    Dim lRWk As Long, lRTot As Long, UB2 As Long, lC As Long
    Dim vOut As Variant, vIn As Variant
    Const lV As Long = 22 'column V
    
    'Check if totals sheet exisits
    On Error Resume Next
    Set wsTot = Sheets("MonthExpenses")
    On Error GoTo 0
    If Not wsTot Is Nothing Then
        'Exists, clear contents
        wsTot.Range("A1").CurrentRegion.ClearContents
    Else
        'create output sheet for month totals
        Set wsTot = Sheets.Add(before:=Sheets(1))
        wsTot.Name = "MonthExpenses"
    End If
    
    'the output array is transposed, so that columns can be added
    ReDim vOut(1 To lV, 1 To 1)
    
    'now loop through each worksheet
    For Each wsWk In ThisWorkbook.Worksheets
        If wsWk.Name <> wsTot.Name Then
            'read the expenses range into an array
            vIn = wsWk.Range("A38").CurrentRegion.Value
            'enlarge the output array to suit the number of rows to _
             be added (the output array is transposed)
            ReDim Preserve vOut(1 To lV, 1 To UB2 + UBound(vIn, 1))
            UB2 = UBound(vOut, 2)   'UB2 holds total number columns in output array
            'copy the values across
            If lRTot = 0 Then   'first sheet, so copy headings
                For lC = 1 To lV
                    vOut(lC, 1) = vIn(1, lC)
                Next lC
                lRTot = 1
            End If
            'now copy each row from the vIn array into the next column of _
             the vOut output array
            For lRWk = 2 To UBound(vIn, 1)
                If vIn(lRWk, 4) = "TOTAL" Then Exit For
                lRTot = lRTot + 1
                For lC = 1 To lV
                    vOut(lC, lRTot) = vIn(lRWk, lC)
                Next lC
            Next lRWk
        End If
    Next wsWk
    'Lastly dump the output array to the consolidation sheet
    wsTot.Range("A1").Resize(UB2, lV).Value = Application.WorksheetFunction.Transpose(vOut)
End Sub

 

[Kayslover]

Sijpie

Firstly, thank you so much for taking the time in coming up with the Macro.

The macro sort of works and I am getting mixed results, which I will report back to you in the next couple of days, once I have had chance to test further.

Looking at your comment at the top you mention that "Assumes that the only worksheets in the book are the weekly sheets.”

This workbook is created by a template and there are other sheets within the Workbook.
Sheets named Monthly Totals, Monthly Receipt No, Lookup and Formula will always exist in the workbook and they need to be excluded as they will not have any weekly expenses items.

When the new sheet is created, the formatting and column widths are out.

As this workbook is created from a Template, I can ensure sheet named “Month Expenses” will always exists. It exist between sheets named “Monthly Receipt No” and “Lookup”.

The new sheet named “Month Expenses” will be created and row 1 will have the Column headings with the appropriate Column width set as well as the appropriate cell formatting (i.e. dates, Currency etc. etc.

As mentioned previously, thanks for taking the time to help so far.

 

[sijpie]

OK, try this code. Check the comment starting with <<< and modify as required

Option Explicit



Sub ConsolidateExpenses()
' put the expense rows from the week sheets into a new _
  monthly consolidated sheet.
 
' Assumes that the only worksheets in the book are the _
  weekly sheets.
  

    Dim wsWk As Worksheet, wsTot As Worksheet
    Dim lRWk As Long, lRTot As Long, UB2 As Long, lC As Long
    Dim vOut As Variant, vIn As Variant
    Const lV As Long = 22 'column V
    Const scSumSht As String = "MonthExpenses"
    Const scShtNames As String = "Monthly Totals;Monthly Receipt No;Lookup;Formula"
    '<<<< Add any fixed sheets that do not need to be processed in the string above
    
    
    'Check if totals sheet exisits
    On Error Resume Next
    Set wsTot = Sheets("MonthExpenses")
    On Error GoTo 0
    If Not wsTot Is Nothing Then
        'Exists, clear contents
        wsTot.Range("A1").CurrentRegion.ClearContents
    Else
        'create output sheet for month totals
        Set wsTot = Sheets.Add(before:=Sheets(1))
        wsTot.Name = scSumSht
    End If
    
    'the output array is transposed, so that columns can be added
    ReDim vOut(1 To lV, 1 To 1)
    
    'now loop through each worksheet
    For Each wsWk In ThisWorkbook.Worksheets
        'check if sheet name does not appear in list of sheets not to be processed
        If Not wsTot.Name & scShtNames Like "*" & wsWk.Name & "*" Then
            'read the expenses range into an array
            vIn = wsWk.Range("A38").CurrentRegion.Value
            'enlarge the output array to suit the number of rows to _
             be added (the output array is transposed)
            ReDim Preserve vOut(1 To lV, 1 To UB2 + UBound(vIn, 1))
            UB2 = UBound(vOut, 2)   'UB2 holds total number columns in output array
            'copy the values across
            If lRTot = 0 Then   'first sheet, so copy headings
                For lC = 1 To lV
                    vOut(lC, 1) = vIn(1, lC)
                Next lC
                lRTot = 1
            End If
            'now copy each row from the vIn array into the next column of _
             the vOut output array
            For lRWk = 2 To UBound(vIn, 1)
                If vIn(lRWk, 4) = "TOTAL" Then Exit For
                lRTot = lRTot + 1
                For lC = 1 To lV
                    vOut(lC, lRTot) = vIn(lRWk, lC)
                Next lC
            Next lRWk
        End If
    Next wsWk
    'Lastly dump the output array to the consolidation sheet
    wsTot.Range("A1").Resize(UB2, lV).Value = Application.WorksheetFunction.Transpose(vOut)
End Sub

 

[Kayslover]

Sijpie

WOW, you have worked wonders with your revised code regarding omitting specific named sheet.

As individual workbooks are created by a template I have created a sheet called “Month Expenses“ in the template and Row 1 has the appropriate titles (as all Expenses sheets Row 38).

I ran your revised code and have identified the following small problems:-

1. Row 37 is copied from the first Sheet to “Month Expenses“ . This is not required.
2. Row 38 is copied from each sheet into the sheet “Month Expenses“, this is not required as the sheet will exist and these heading will already be in the sheet.
3. Cells E39:E59, F39:F59 and G39:G59 in the sheets that data is being copied from have been set up as a Currency format with a currency symbol being shown and 2 decimal places. When this data is copied, these cells are showing as Text and not currency.
4. If the first sheet does not have any Expenses data, then the code falls in the code at the line that says vOut(lC, 1) = vIn(1, lC) which is located after the comment 'first sheet, so copy headings”.
   The message of the failure is “Run Time Error 9, Subscript out of range”.
5. If any of the subsequent sheets do not have any expenses data, then the code falls in the code at the line that says vOut(lC, lRTot) = vIn(lRWk, lC) which is located after the comment “now copy each row from the vIn array into the next column of the vOut output array”. The message of the failure is “Run Time Error 9, Subscript out of range”.
6. Additional data being copied when additional expenses rows have been added (see below).

Please note the following as it may help you to identify why certain additional data is being copied.

Normally Rows 39 to Row 59 MAY have expenses data. Cell D60 has the word TOTAL (B) in it to signify the end of the Expenses data range.
If additional expenses data lines are required, then the user can add rows, and therefore the row with D60 with the word TOTAL will move further down but will always be there.

Example of additional rows of Expenses.

Sheet named Sheet1 has data for Expenses in Rows 39 to Row 41. This is copied as expected to the new sheet.

Sheet named Sheet2 has data for Expenses in Rows 39. This is copied as expected to the new sheet.

Sheet named Sheet3 has data for Expenses in Rows 39 to Row 72. And therefore what was formally row 60 with the Column D reading Total (B) has now moved to row 73. Data from rows 39 to rows 59 are copied as expected. However, it also copied data from rows 60 to 82 (There is no more data after this row).

Sheet named Sheet4 has data for Expenses in Rows 39 to Row 42. This is copied as expected to the new sheet.

Would it help if I shared some of the data with you? If so can you guide me as I haven't got a clue.

Once again, I really really appreciate your kind assistance.