Excel VBA Course
Excel VBA Course - From Beginner to Expert

200+ Video Lessons
50+ Hours of Video
200+ Excel Guides

Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)

View Course

VBA to paste date to extracted range


Hi, So i Have this VBA code that filters a table with the contents of a pivot table being it's criteria and pastes it to another location. and by the side of the filtered data it adds a timestamp column and adds date to every row of the filtered data

The problem that i am having is that i made a new file that needs the same thing to be done. and made the changes accordingly in the VBA code. But somehow the date is not being pasted in the new file.

Sub AdvanceFilter()
Dim Table As ListObject
Dim PT As PivotTable
Dim PasteCell As Range, n As Long 'variable, target cell for top left of pasted data

'Apply speed up options
Application.EnableEvents = False ' prevent event macros triggering
Application.ScreenUpdating = False ' to speed up macro
Application.Calculation = xlCalculationManual ' stop calcs

With Sheet14 ' specify the sheet
    Set PT = .PivotTables("AdvanceFilterCriteriaPivot")
    Set Table = .ListObjects("Master_IN_OUT")

    Set PasteCell = .Range("CT" & .Range("CT" & .Rows.Count).End(xlUp).Row + 3) 'get CT and last used row + 3

    ' change target for paste to the above and copy
    Table.Range.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=PT.TableRange1, Unique:=False
    Table.Range.SpecialCells(xlCellTypeVisible).Copy Destination:=PasteCell

    PasteCell.Offset(-1, 0).Value = Now 'add date and time above pasted data
    PasteCell.Offset(-1, 1).Value = "Extract:" 'add name after the above
    PasteCell.Resize(1, 17).Font.Color = vbBlack 'change pasted header row from white to black
 'Put date (for XLOOKUP)
    PasteCell.Offset(0, -1).Value = "Date paid" ' Add column heading
    For n = PasteCell.Row + 1 To .Range("CT" & .Rows.Count).End(xlUp).Row
            .Range("CS" & n).Value = Date ' insert today's date
         Next n

    'Turn calcs back on to evaluate XLOOKUP formulae


End With

Application.EnableEvents = True 'reset events, screen and calcs
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub



Selected Answer


If I type 

Debug.Print Sheet14.PivotTables("AdvanceFilterCriteriaPivot").Name

in the VBA Intermediate Window, I get an error since that object (Pivot table) doesn't exist. Likewise, running your code fails for that reason (at least),. Suggest you correct that and try again.

As I suggested below, the problem can be fis=xed by adding a pivot table to the worksheet Data (so VBA can find it and filter it). In the file attached, I copied the pivot table from the previous solution to cell AN34 but changed the data source to the first columns of the Master_In PT on that sheet, i.e. the data source is: of 


and you can select the filters for Party/ Machine in the PT below yellow cell AN32.

I modified one line in the code to read this:

For n = PasteCell.Row + 1 To .Range("CU" & .Rows.Count).End(xlUp).Row ' #### changed this

since some cells in the table did not have an entry in the first column (CT in the pasted data) so used the Party data CU instead.

I might have this wrong but hopefully it helps you sort the problem.



But the same code works on the other file! its  just the column names that i have changed. it as also working here. It is filtering and pasting the data. Just that its not stamping the date under "Date Paid" column
asif_187 (rep: 6) Apr 18, '22 at 9:26 am
Asif, the code looks for that pivot table (needed later for the filter. Criteria) and crashes on that Set line when it can't be found.

You could try copying the PT from the oither file. I'm not near my PC so cant help further at present. 
John_Ru (rep: 3222) Apr 18, '22 at 9:50 am
So this is the progress. it is pasting dates but not for all filtered values. i think its some mishap in the filter criteria part. here is the final file with lookup formulas. I am to filter data (with a pivotable being the criteria) and paste it in row CT and date when it was filtered in row CS. would appreciate any help. PS. The code was written by you in the first place itself and has been of IMMENSE help ever since then. And true:the PT line does give trouble every now and then. and it becomes a nightmare to solve it :'(
asif_187 (rep: 6) Apr 18, '22 at 10:31 am
Asif, plese remind me when I wrote that code (or give a link to that Answer) . I'll then try to look at later today or tomorrow. 
John_Ru (rep: 3222) Apr 18, '22 at 11:00 am
asif_187 (rep: 6) Apr 18, '22 at 11:36 pm
Please see revised Answer 
John_Ru (rep: 3222) Apr 20, '22 at 3:01 am
Asif- did that work for you?
John_Ru (rep: 3222) Apr 21, '22 at 6:00 am
Hi. Sorry. Been super busy. Will sit down with it tonight or tomorrow and revert.
asif_187 (rep: 6) Apr 23, '22 at 1:55 am
Okay, no problem. 
John_Ru (rep: 3222) Apr 23, '22 at 2:10 am
Hi. Its working though. But if i am using the code the second time and henceforth, instead of copying the data after (or below) the first pasted data set, its pasting it on top of the first pasted data. :O.  In a way its re-wriring it on top of it.
asif_187 (rep: 6) Apr 24, '22 at 5:00 am

Try changing the determination of variable PasteCell so it skips the (possible) blank cells in CT by modifying the Set line as follows (changes in bold):
Set PasteCell = .Range("CT" & .Range("CU" & .Rows.Count).End(xlUp).Row + 3) 'get CT and last used row in CU + 3
John_Ru (rep: 3222) Apr 25, '22 at 9:43 am
works ! you are a genious !
asif_187 (rep: 6) Apr 26, '22 at 4:55 am
Thanks for selecting my answer, Asif.

In reality, I just corrected an error I should have noticed. Quite pleased I was able to correct it wirhout using my PC though! 
John_Ru (rep: 3222) Apr 26, '22 at 5:31 am
Add to Discussion

Answer the Question

You must create an account to use the forum. Create an Account or Login