VBA Code to fetch data every particular day in a month

R

ripdaman

New Member
Joined
Mar 11, 2023
Messages
8
Office Version
  1. 365
Platform
  1. Windows
Book1.xlsx
ABCDEFGHIJKL
2Table 1Table 2Table 3Table 4
3DateValueDateValueDateValueDateValue
410 August 202412 August 202416 August 202423 August 2024
510 September 202412 September 202416 September 202423 September 2024
610 October 202412 October 202416 October 202423 October 2024
710 November 202412 November 202416 November 202423 November 2024
810 December 202412 December 202416 December 202423 December 2024
910 January 202512 January 202516 January 202523 January 2025
1010 February 202512 February 202516 February 202523 February 2025
1110 March 202512 March 202516 March 202523 March 2025
1210 April 202512 April 202516 April 202523 April 2025
1310 May 202512 May 202516 May 202523 May 2025
1410 June 202512 June 202516 June 202523 June 2025
1510 July 202512 July 202516 July 202523 July 2025
1610 August 202512 August 202516 August 202523 August 2025
1710 September 202512 September 202516 September 202523 September 2025
1810 October 202512 October 202516 October 202523 October 2025
19
20
21126.5810.521059.44548.03
Sheet1


My excel sheet has four tables, Table 1 through Table 4 with dates from Aug, 2024 till Oct, 2025. The cells in the Table 1 take values from Cell C21 which in turn takes its value from an external source that auto populates when I refresh the data. Table 2 takes its values from Cell F21 and so on. These values correspond to the first entry (i.e. the month of August) in each table.

What is desired is that on or after the dates mentioned in each Table, the values should be fetched from corresponding cells C21, F21 and so on. Which means that the value in Cell C4 in Table 1 for the month of Aug, 2024 should be 126.58. Then on or after 10th Sep, 2024, the cell C5 in Table 1 should again fetch the updated value from cell C21 and so on for all the months in Table 1. Ditto for all other Tables.

How can this be done? Thanks in advance.
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
Sort by date Sort by votes
Try the following macro:
VBA Code: 
Sub SetInTables()
'D:\DDownloads\[MULTI_C40731.xlsm]Foglio3
Dim ccDate As Date, tDate As Long
Dim myMatch, I As Long
'
tDate = 0                     'Debug only
ccDate = Date + tDate
For I = 1 To 4
    With ActiveSheet.ListObjects("Table" & I)
        Debug.Print .ListColumns(1).Range.Address, ccDate
        myMatch = Application.Match(CLng(ccDate), .ListColumns(1).DataBodyRange)
        If Not IsError(myMatch) Then
            If .ListColumns(1).DataBodyRange.Cells(myMatch, 2) = "" Then
                .ListColumns(1).DataBodyRange.Cells(myMatch, 2).Value = Cells(21, .ListColumns(1).DataBodyRange.Cells(myMatch, 2).Column)
            End If
        End If
    End With
Next I
End Sub
This assumes that the tables are on the active sheet, they are "structured tables (i.e. ListObjects)" and are named Table1, Table2, Table3, Table4
The current Date is matched against column 1 of the tables (using the option "equal or greater than"), and if the matched row is still Empty it will be filled with the value of row 21.
The variable tDate is used as "offset days with respect to Today" ans is useful for debug only.

After running the macro simulating Date=13-aug and Date=13-Sep the result is shown below:
MULTI_C40731.xlsm
ABCDEFGHIJKLM
1
2
3DateValueDateValueDateValueDateValue
410-ago-24126,5812-ago-2410,5216-ago-241059,4423-ago-24548.03
510-set-24126,5812-set-2410,5216-set-2423-set-24
610-ott-2412-ott-2416-ott-2423-ott-24
710-nov-2412-nov-2416-nov-2423-nov-24
810-dic-2412-dic-2416-dic-2423-dic-24
910-gen-2512-gen-2516-gen-2523-gen-25
1010-feb-2512-feb-2516-feb-2523-feb-25
1110-mar-2512-mar-2516-mar-2523-mar-25
1210-apr-2512-apr-2516-apr-2523-apr-25
1310-mag-2512-mag-2516-mag-2523-mag-25
1410-giu-2512-giu-2516-giu-2523-giu-25
1510-lug-2512-lug-2516-lug-2523-lug-25
1610-ago-2512-ago-2516-ago-2523-ago-25
1710-set-2512-set-2516-set-2523-set-25
1810-ott-2512-ott-2516-ott-2523-ott-25
19
20
21126,5810,521059,44548.03
22
23
Foglio3
 
Upvote 0
Anthony47 said:
Try the following macro:
VBA Code: 
Sub SetInTables()
'D:\DDownloads\[MULTI_C40731.xlsm]Foglio3
Dim ccDate As Date, tDate As Long
Dim myMatch, I As Long
'
tDate = 0                     'Debug only
ccDate = Date + tDate
For I = 1 To 4
    With ActiveSheet.ListObjects("Table" & I)
        Debug.Print .ListColumns(1).Range.Address, ccDate
        myMatch = Application.Match(CLng(ccDate), .ListColumns(1).DataBodyRange)
        If Not IsError(myMatch) Then
            If .ListColumns(1).DataBodyRange.Cells(myMatch, 2) = "" Then
                .ListColumns(1).DataBodyRange.Cells(myMatch, 2).Value = Cells(21, .ListColumns(1).DataBodyRange.Cells(myMatch, 2).Column)
            End If
        End If
    End With
Next I
End Sub
This assumes that the tables are on the active sheet, they are "structured tables (i.e. ListObjects)" and are named Table1, Table2, Table3, Table4
The current Date is matched against column 1 of the tables (using the option "equal or greater than"), and if the matched row is still Empty it will be filled with the value of row 21.
The variable tDate is used as "offset days with respect to Today" ans is useful for debug only.

After running the macro simulating Date=13-aug and Date=13-Sep the result is shown below:
MULTI_C40731.xlsm
ABCDEFGHIJKLM
1
2
3DateValueDateValueDateValueDateValue
410-ago-24126,5812-ago-2410,5216-ago-241059,4423-ago-24548.03
510-set-24126,5812-set-2410,5216-set-2423-set-24
610-ott-2412-ott-2416-ott-2423-ott-24
710-nov-2412-nov-2416-nov-2423-nov-24
810-dic-2412-dic-2416-dic-2423-dic-24
910-gen-2512-gen-2516-gen-2523-gen-25
1010-feb-2512-feb-2516-feb-2523-feb-25
1110-mar-2512-mar-2516-mar-2523-mar-25
1210-apr-2512-apr-2516-apr-2523-apr-25
1310-mag-2512-mag-2516-mag-2523-mag-25
1410-giu-2512-giu-2516-giu-2523-giu-25
1510-lug-2512-lug-2516-lug-2523-lug-25
1610-ago-2512-ago-2516-ago-2523-ago-25
1710-set-2512-set-2516-set-2523-set-25
1810-ott-2512-ott-2516-ott-2523-ott-25
19
20
21126,5810,521059,44548.03
22
23
Foglio3
Click to expand...
Thanks
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question
Calc cumulative by month
Replies
6
Views
170
mylamly26
M
S
  • Question
Employee Training Tracker
Replies
0
Views
199
Schuyla
S
M
  • Solved
Nested Xlookup not returning all data
Replies
2
Views
327
Mat1968
M
J
  • Question
Using index and match from another source excel file
2
Replies
10
Views
542
Peter_SSs
Peter_SSs
K
  • Question
Copy data from vertical cells paste into horizontal cells that will change each time macro run
Replies
1
Views
102
sxhall
S

Forum statistics

Threads
1,221,310
Messages
6,159,173
Members
451,543
Latest member
cesymcox

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top