Help with Macro, as it is not extracting all the data.

[Kayslover]

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”.

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 Sub

The 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

 

[Fluff]

The 2nd argument in all your Range.Resize is 10 which takes you to col J (based on starting in col A), try changing it to 14

 

[Kayslover]

Fluff,

That was quick. I just switched off my PC so will try out your recommendations tomorrow.

Thank you very much.

 

[Fluff]

Ok, that's fine

 

[Kayslover]

Fluff,

Changed all occurrences of 10 to 14 and it works as expected, so thank you very much. . You are a ?.

I have a futher question for you on the macro. Is it possible to have to 2 arrays set up which creates 2 sheets?

Sheet Month Expenses to only extract Column A to E, and H to N providing there is data in Column D.

Sheet Month Expenses Non Cash to only extract Column A to C, and F to N providing there is data in Column F or G.

Any further assistance you can offer will be appreciated.

 

[Fluff]

As that is a totally different question it needs a new thread. Thanks

 

[Kayslover]

Fluff,

Ok, will start a new thread and once again thanks you very much for your assistance.

 

[Fluff]

You're welcome & thanks for the feedback.