I have the following code (macro) which is used to consolidate data from 4 or 5 sheets and output the consolidated data into a sheet called “Month Expenses”.
The following is a copy of data in 1 of the sheets, (I have not included other sheets as the layout is the same).
The following is the output generate by running the macro.
The problem with the macro is that I have almost all the data in the Monthly Expenses sheet, EXCEPT data from columns K to N are not extracted.
You will note that data from columns K to N from sheet called 03-Jan-21 are NOT being transferred to Columns K and N in the sheet called Month Expenses. This is also the case for other sheets that are part of the Array.
Any ideas why data from columns K to N are not being populated?
I will be grateful for any assistance offered.
VBA Code:
Public Sub ConsolidateExpenses()
Application.ScreenUpdating = False
Application.DisplayAlerts = True
Application.StatusBar = True
Dim a()
Dim sht
Dim ws As Worksheet
Dim rf As Range
Dim i As Integer
Dim d As Long
Dim MyNoOfWeek As Integer
Dim LstRw As Long, PrnG As Range
Application.DisplayAlerts = False
'Get the number of weeks in the month from sheet Formula, cell H2
Sheets("Formula").Select
MyNoOfWeek = Range("H2").Value
'Have to unprotect the Weekly Sheets and Formula sheets.
'The weekly sheets are being referenced here by their Excel Internal names as the sheet names change every month, were as the Internal names stay the same.
Sheet1.Unprotect Password:=""
Sheet8.Unprotect Password:=""
Sheet10.Unprotect Password:=""
Sheet11.Unprotect Password:=""
Sheets("Month Expenses").Unprotect Password:=""
Sheets("Formula").Unprotect Password:=""
If MyNoOfWeek = 5 Then
Sheet12.Unprotect Password:=""
End If
'If the number of week in the month is 4, then set the array to 4 sheets, otherwise set it to 5 sheets. The array has to be build to extract the required data from either 4 or 5 weekly sheets that the month has.
Sheets("Formula").Select
MyNoOfWeek = Range("H2").Value
If MyNoOfWeek = 4 Then
sht = Array(Sheet1, Sheet8, Sheet10, Sheet11)
Else
sht = Array(Sheet1, Sheet8, Sheet10, Sheet11, Sheet12)
End If
Application.ScreenUpdating = False
Application.EnableEvents = False
sht = Array(Sheet1, Sheet8, Sheet10, Sheet11, Sheet12)
Sheets("Month Expenses").UsedRange.Offset(3).ClearContents
For i = 0 To UBound(sht)
With sht(i)
Set rf = .Columns.Find("Ref")
If Not rf Is Nothing Then
Set rf = rf.Offset(1).Resize(.Columns(1).Find("B", LookAt:=xlWhole).Row - rf.Row - 1, 10)
If Not rf Is Nothing Then
On Error Resume Next
a = rf.Columns(1).SpecialCells(xlCellTypeConstants).Resize(, 10).Value
If Err.Number = 0 Then
With Sheets("Month Expenses")
With .Range("A" & .Cells(Rows.Count, "A").End(3).Row)(2)
.Resize(UBound(a), 10) = a
Erase a
End With
End With
End If
Err.Clear
End If
End If
End With
Next
'Change the value of the sum in columns E, F and G to paste Values.
With Sheets("Month Expenses")
i = .[a3].CurrentRegion.Columns(1).Rows.Count - 3
With .[e3].Resize(, 3)
.FormulaR1C1 = "=sum(r[1]c:r[" & i & "]c)"
.Value = .Value
End With
End With
Set rf = Nothing
'Set Print area for sheet
LstRw = Cells(Rows.Count, "A").End(xlUp).Row
Set PrnG = Range("A1:L" & LstRw) ' or whatever column you want
ActiveSheet.PageSetup.PrintArea = PrnG.Address
'Password protect all Sheets in the workbook, But allow formatting cells (so that when you select a cell the colour changes) and to allow Inserting of rows.
For Each ws In ActiveWorkbook.Worksheets
ws.Protect Password:="", AllowFormattingCells:=True, AllowInsertingRows:=True
Next ws
'Sheets named Monthly Totals, Monthly Receipt No, Month Expenses, and Lookup should not be Protected.
'Sheets("Monthly Totals").Unprotect ""
'Sheets("Monthly Receipt No").Unprotect ""
Sheets("Lookup").Unprotect ""
Sheets("Month Expenses").Unprotect ""
Sheets("Month Expenses").Select
Application.ScreenUpdating = True
Application.EnableEvents = True
MsgBox "Consolidatation of monthly data has completed.", Title:="Monthly Data Consolidation"
End SubThe following is a copy of data in 1 of the sheets, (I have not included other sheets as the layout is the same).
| 01 January.xlsm | ||||||||||||||||
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| A | B | C | D | E | F | G | H | I | J | K | L | M | N | |||
| 38 | Ref | Date | From | Treasurer Ref | Receipt Amount | Pay Smith | Pay Jones | Cost Classification | Comments | |||||||
| 39 | 0001 | 03/01/21 | Ancillary Payment | 21001 | £56.00 | Maintenance - Club House | Pay Electrician for doing plugs in Club House | |||||||||
| 40 | 0002 | 04/01/21 | Costco | £500.00 | Bar | Bar Purchases | ||||||||||
| 41 | 0003 | 03/01/21 | Aldi | 21002 | £3.00 | Cleaning Items | For General Cleaning | |||||||||
| 42 | 0004 | 04/01/21 | B&M | 21003 | £4.00 | Cleaning Items | For General Cleaning | |||||||||
| 43 | 0005 | 05/01/21 | Sainsbury | 21004 | £5.00 | Cleaning Items | For General Cleaning | |||||||||
| 44 | 0006 | 06/01/21 | Asda | 21005 | £6.00 | Cleaning Items | For General Cleaning | |||||||||
| 45 | 0007 | 07/01/21 | Tesco | 21006 | £7.00 | Cleaning Items | For General Cleaning | |||||||||
| 46 | 0008 | 08/01/21 | Morrissions | 21007 | £8.00 | Cleaning Items | For General Cleaning | |||||||||
| 47 | 0009 | 09/01/21 | Lidl | 21008 | £9.00 | Cleaning Items | For General Cleaning | |||||||||
| 48 | 0010 | 01/01/21 | Poundstretcher | 21009 | £10.00 | Cleaning Items | For General Cleaning | |||||||||
| 49 | 0011 | 02/01/21 | Alan Hartley | 21010 | £11.00 | Cleaning Items | For General Cleaning | |||||||||
| 50 | 0012 | 03/01/21 | Boss Gas | 21011 | £12.00 | Cleaning Items | For General Cleaning | |||||||||
| 51 | 0013 | 04/01/21 | Amazon | 21012 | £13.00 | Cleaning Items | For General Cleaning | |||||||||
| 52 | 0014 | 05/01/21 | Canal Cellars | 21013 | £14.00 | Cleaning Items | For General Cleaning | |||||||||
| 53 | 0015 | 06/01/21 | Heron Foods | 21014 | £15.00 | Cleaning Items | For General Cleaning | |||||||||
| 54 | 0016 | 07/01/21 | Costco | 21015 | £16.00 | Cleaning Items | For General Cleaning | |||||||||
| 55 | 0017 | 08/01/21 | Booker | 21016 | £17.00 | Cleaning Items | For General Cleaning | |||||||||
| 56 | 0018 | 09/01/21 | Aldi | 21017 | £18.00 | Cleaning Items | For General Cleaning | |||||||||
| 57 | 0019 | 01/01/21 | B&M | 21018 | £19.00 | Cleaning Items | For General Cleaning | |||||||||
| 58 | 0020 | 02/01/21 | Sainsbury | 21019 | £20.00 | Cleaning Items | For General Cleaning | |||||||||
| 59 | 0021 | 03/01/21 | Asda | 21020 | £21.00 | Cleaning Items | For General Cleaning | |||||||||
| 60 | 0022 | 04/01/21 | Tesco | 21021 | £22.00 | Cleaning Items | For General Cleaning | |||||||||
| 61 | 0023 | 05/01/21 | Morrissions | 21022 | £23.00 | Cleaning Items | For General Cleaning | |||||||||
| 62 | 0024 | 06/01/21 | Lidl | 21023 | £24.00 | Cleaning Items | For General Cleaning | |||||||||
| 63 | 0025 | 07/01/21 | Poundstretcher | 21024 | £25.00 | Cleaning Items | For General Cleaning | |||||||||
| 64 | 0026 | 08/01/21 | Alan Hartley | 21025 | £26.00 | Cleaning Items | For General Cleaning | |||||||||
| 65 | 0027 | 09/01/21 | Boss Gas | 21026 | £27.00 | Cleaning Items | For General Cleaning | |||||||||
| 66 | 0028 | 01/01/21 | Amazon | 21027 | £28.00 | Cleaning Items | For General Cleaning | |||||||||
| 67 | 0029 | 02/01/21 | Canal Cellars | 21028 | £29.00 | Cleaning Items | For General Cleaning | |||||||||
| 68 | 0030 | 03/01/21 | Heron Foods | 21029 | £30.00 | Cleaning Items | For General Cleaning | |||||||||
| 69 | 0031 | 04/01/21 | Costco | 21030 | £31.00 | Cleaning Items | For General Cleaning | |||||||||
| 70 | 0032 | 05/01/21 | Booker | 21031 | £32.00 | Cleaning Items | For General Cleaning | |||||||||
| 71 | 0033 | 06/01/21 | Aldi | 21032 | £33.00 | Cleaning Items | For General Cleaning | |||||||||
| 72 | 0034 | 07/01/21 | B&M | 21033 | £34.00 | Cleaning Items | For General Cleaning | |||||||||
| 73 | 0035 | 08/01/21 | Sainsbury | 21034 | £35.00 | Cleaning Items | For General Cleaning | |||||||||
| 74 | ||||||||||||||||
| 75 | ||||||||||||||||
| 76 | ||||||||||||||||
| 77 | B | TOTAL (B) | £683.00 | £500.00 | £0.00 | |||||||||||
03-Jan-21 | ||||||||||||||||
| Cell Formulas | ||
|---|---|---|
| Range | Formula | |
| E77:G77 | E77 | =SUM(E39:E76) |
The following is the output generate by running the macro.
The problem with the macro is that I have almost all the data in the Monthly Expenses sheet, EXCEPT data from columns K to N are not extracted.
You will note that data from columns K to N from sheet called 03-Jan-21 are NOT being transferred to Columns K and N in the sheet called Month Expenses. This is also the case for other sheets that are part of the Array.
Any ideas why data from columns K to N are not being populated?
I will be grateful for any assistance offered.
| 01 January.xlsm | ||||||||||||||
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| A | B | C | D | E | F | G | H | I | J | K | L | |||
| 1 | Monthly Cash Expenses for January 2021 | |||||||||||||
| 2 | Ref | Date | From | Treasurer Ref | Receipt Amount | Pay Smith | Pay Jones | Cost Classification | Comments | |||||
| 3 | Full Monthly Cash Items Totals | £1,463.00 | £690.00 | £371.00 | ||||||||||
| 4 | 0001 | 03/01/21 | Ancillary Payment | 21001 | £56.00 | Maintenance - Club House | ||||||||
| 5 | 0002 | 04/01/21 | Costco | £500.00 | Bar | |||||||||
| 6 | 0003 | 03/01/21 | Aldi | 21002 | £3.00 | Cleaning Items | ||||||||
| 7 | 0004 | 04/01/21 | B&M | 21003 | £4.00 | Cleaning Items | ||||||||
| 8 | 0005 | 05/01/21 | Sainsbury | 21004 | £5.00 | Cleaning Items | ||||||||
| 9 | 0006 | 06/01/21 | Asda | 21005 | £6.00 | Cleaning Items | ||||||||
| 10 | 0007 | 07/01/21 | Tesco | 21006 | £7.00 | Cleaning Items | ||||||||
| 11 | 0008 | 08/01/21 | Morrissions | 21007 | £8.00 | Cleaning Items | ||||||||
| 12 | 0009 | 09/01/21 | Lidl | 21008 | £9.00 | Cleaning Items | ||||||||
| 13 | 0010 | 01/01/21 | Poundstretcher | 21009 | £10.00 | Cleaning Items | ||||||||
| 14 | 0011 | 02/01/21 | Alan Hartley | 21010 | £11.00 | Cleaning Items | ||||||||
| 15 | 0012 | 03/01/21 | Boss Gas | 21011 | £12.00 | Cleaning Items | ||||||||
| 16 | 0013 | 04/01/21 | Amazon | 21012 | £13.00 | Cleaning Items | ||||||||
| 17 | 0014 | 05/01/21 | Canal Cellars | 21013 | £14.00 | Cleaning Items | ||||||||
| 18 | 0015 | 06/01/21 | Heron Foods | 21014 | £15.00 | Cleaning Items | ||||||||
| 19 | 0016 | 07/01/21 | Costco | 21015 | £16.00 | Cleaning Items | ||||||||
| 20 | 0017 | 08/01/21 | Booker | 21016 | £17.00 | Cleaning Items | ||||||||
| 21 | 0018 | 09/01/21 | Aldi | 21017 | £18.00 | Cleaning Items | ||||||||
| 22 | 0019 | 01/01/21 | B&M | 21018 | £19.00 | Cleaning Items | ||||||||
| 23 | 0020 | 02/01/21 | Sainsbury | 21019 | £20.00 | Cleaning Items | ||||||||
| 24 | 0021 | 03/01/21 | Asda | 21020 | £21.00 | Cleaning Items | ||||||||
| 25 | 0022 | 04/01/21 | Tesco | 21021 | £22.00 | Cleaning Items | ||||||||
| 26 | 0023 | 05/01/21 | Morrissions | 21022 | £23.00 | Cleaning Items | ||||||||
| 27 | 0024 | 06/01/21 | Lidl | 21023 | £24.00 | Cleaning Items | ||||||||
| 28 | 0025 | 07/01/21 | Poundstretcher | 21024 | £25.00 | Cleaning Items | ||||||||
| 29 | 0026 | 08/01/21 | Alan Hartley | 21025 | £26.00 | Cleaning Items | ||||||||
| 30 | 0027 | 09/01/21 | Boss Gas | 21026 | £27.00 | Cleaning Items | ||||||||
| 31 | 0028 | 01/01/21 | Amazon | 21027 | £28.00 | Cleaning Items | ||||||||
| 32 | 0029 | 02/01/21 | Canal Cellars | 21028 | £29.00 | Cleaning Items | ||||||||
| 33 | 0030 | 03/01/21 | Heron Foods | 21029 | £30.00 | Cleaning Items | ||||||||
| 34 | 0031 | 04/01/21 | Costco | 21030 | £31.00 | Cleaning Items | ||||||||
| 35 | 0032 | 05/01/21 | Booker | 21031 | £32.00 | Cleaning Items | ||||||||
| 36 | 0033 | 06/01/21 | Aldi | 21032 | £33.00 | Cleaning Items | ||||||||
| 37 | 0034 | 07/01/21 | B&M | 21033 | £34.00 | Cleaning Items | ||||||||
| 38 | 0035 | 08/01/21 | Sainsbury | 21034 | £35.00 | Cleaning Items | ||||||||
| 39 | 0036 | 15/01/21 | Booker | £200.00 | Bar | |||||||||
| 40 | 0037 | 16/01/21 | Ancillary Payment | 21035 | £300.00 | Coco Services | ||||||||
| 41 | 0038 | 21/01/21 | Amazon | 21036 | £53.00 | Maintenance - Ground | ||||||||
| 42 | 0039 | 21/01/21 | Tesco | 21037 | £21.00 | Fuel for Machinery | ||||||||
| 43 | 0040 | 21/01/21 | Amazon | £10.00 | Bar | |||||||||
| 44 | 0041 | 21/01/21 | Tesco | £11.00 | Bar | |||||||||
| 45 | 0042 | 21/01/21 | Amazon | £12.00 | Bar | |||||||||
| 46 | 0043 | 21/01/21 | Tesco | £13.00 | Bar | |||||||||
| 47 | 0044 | 21/01/21 | Amazon | £14.00 | Bar | |||||||||
| 48 | 0045 | 21/01/21 | Tesco | £15.00 | Bar | |||||||||
| 49 | 0046 | 21/01/21 | Amazon | £16.00 | Bar | |||||||||
| 50 | 0047 | 21/01/21 | Tesco | £17.00 | Bar | |||||||||
| 51 | 0048 | 21/01/21 | Amazon | £18.00 | Bar | |||||||||
| 52 | 0049 | 21/01/21 | Tesco | £19.00 | Bar | |||||||||
| 53 | 0050 | 21/01/21 | Amazon | £20.00 | Bar | |||||||||
| 54 | 0051 | 21/01/2021 | Tesco | £21.00 | Bar | |||||||||
| 55 | 0052 | 21/01/2021 | Amazon | £22.00 | Bar | |||||||||
| 56 | 0053 | 21/01/2021 | Tesco | £23.00 | Bar | |||||||||
| 57 | 0054 | 21/01/2021 | Amazon | £24.00 | Bar | |||||||||
| 58 | 0055 | 21/01/2021 | Tesco | £25.00 | Bar | |||||||||
| 59 | 0056 | 21/01/2021 | Amazon | £26.00 | Bar | |||||||||
| 60 | 0057 | 21/01/2021 | Tesco | £27.00 | Bar | |||||||||
| 61 | 0058 | 21/01/2021 | Home Bargains | £28.00 | Bar | |||||||||
| 62 | 0059 | 01/02/2021 | B&M | 21038 | £1.00 | Cleaning Items | ||||||||
Month Expenses | ||||||||||||||
| Cell Formulas | ||
|---|---|---|
| Range | Formula | |
| A1 | A1 | ="Monthly Cash Expenses for "&" "&TEXT(Formula!E2,"MMMM yyyy") |
| A3 | A3 | ="Full Monthly Cash Items Totals" |
| Cells with Data Validation | ||
|---|---|---|
| Cell | Allow | Criteria |
| C4:C22,C24:C53 | List | =Brought_Id |
| C23 | List | =Brought_Id |
. You are a ?.
