• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Copy and Paste from One sheet to Another based on a Date Criteria

PeterDavids

New Member
Dear All

I am in need of assistance of a macro that copies the contents of a cell in one sheet and then looks for the date intersection in another sheet and pastes the value in the second sheet.

The first sheet contains the data to be copied and the dynamic date for the data.

The second sheet contains a list of dates that needs to be referenced. The cell content from the first sheet has to be copied to the second sheet at the intersection of the dates that match on sheet 1 and sheet 2.

The attached file simulation contains further explanations.

Thanks
Peter
 

Attachments

  • BalanceCopy.xlsm
    15.6 KB · Views: 7
Hello Peter,

If I've understood you correctly, I think that the following will help:-

Place this code in a standard module:-

Code:
Sub Test()

        Dim Sval As Range, ws As Worksheet, wsA As Worksheet
        Dim AccName As String
        
Application.ScreenUpdating = False
        
        Set wsA = Sheets("Account_Movement")
        
For Each ws In Worksheets

        Set Sval = ws.Columns("A:A").Find(wsA.Range("F7").Value)
        AccName = ws.[A1].Value
        
      If ws.Name <> "Account_Movement" Then
            If wsA.Range("F7").Value = Sval.Value Then
                    With wsA.Range("E10:E20")
                        .AutoFilter 1, AccName
                            With .Offset(1, 2)
                                   .Copy Sval.Offset(, 4)
                                   .AutoFilter
                            End With
                    End With
             End If
       End If
Next ws

Application.ScreenUpdating = True

End Sub

then place this in the Account_Movement sheet code:-

Code:
Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("F7")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target.Value = vbNullString Then Exit Sub

Test

End Sub

Once a date is entered in F7 of the Account_Movement sheet, the Worksheet_Change event code will call the "Test" code which will transfer the balances to the relevant worksheets. No buttons are needed, just press enter or down arrow or click away.

I hope that this helps.

Cheerio,
vcoolio.
 
Hi vcoolio

The code works perfectly, big thank you!
The only issue arises when there are more than these two worksheets in the file.
I have about 20 worksheets in the file and Account_Movement sheet is the "source" sheet and Account #7 is the "target" sheet.
When there are these multiple worksheets in the file I get the "Run-time error '91': Object variable or With block variable not set

It this as a result of having these multiple worksheets in the workbook?

Could I please ask for your further assistance if you don't mind?

Thanks
Peter
 
Hello Peter,

I've attached your sample workbook in which I've added a few extra worksheets named as per the list in the "Account_Movement" worksheet. I simply created copies of the Account #7 worksheet and just changed the worksheet name in cell A1 of each worksheet. You'll note that the code works in the sample exactly as it should.

I would say that the error you are receiving is due to possibly:-
1) Your actual workbook not having the sheet names in A1 of each sheet.

or

2) The filtered range in the code is fixed at E10:E20 in the the "Account_Movement" sheet. You say that you have twenty worksheets to work through so the range may need to be E10:E30 ?
We can, of course, make this range dynamic if need be. That is, from E10:last cell (if you have varying numbers of worksheets).

or

3) You've altered the code a little.

Let us know how it goes.

Cheerio,
vcoolio.

P.S. Peter.
Are the destination sheets named in the same manner? That is: Account #1, Account #2, Account #3 etc........
 

Attachments

  • PeterDavids.xlsm
    28.7 KB · Views: 9
Last edited:
Dear vcoolio

I really feel like I am taking up to much of your time.
But for the life of me I can't seem to get the code to work in my actual workbook although it works perfectly in all my test-case example file.
I always get the error below:

70865

Does this help with the diagnosis?
Sorry for all the trouble.
Thanks
Peter
 
Hello Peter,

Not to worry. I'm sure we'll get to the bottom of this.

Could you please upload your actual workbook. Dumb it down though as we don't want sensitive data on a public forum. Just ensure you have the source sheet and only two or three of the destination sheets included in the new sample. Make sure that the sample is an exact replica of your actual workbook and please ensure that the codes are included in their respective modules as well.

Cheerio,
vcoolio.
 
Hi vcoolio

Thanks for your patience I really do appreciate it.

As per your instruction I have uploaded a sanitized version of the actual workbook. As a further point of clarification, I only need ONE account - "UCT-Property Investment" which is located in cell E43 and its balance located in cell V43 to be copied to the sheet UCT-Property Investment to the date intersection as displayed on the two sheets.

I DO NOT need any other balance to be copied to any other worksheet. ONLY this one account balance.

I trust that this is of help.

Regards
Peter
 
Ah. So you are only dealing with the one account, one worksheet in this case. Hence the error.

If you just want the balance transferred over to the UCT-Property Investment sheet then this should work for you:-

Code:
Option Explicit
Sub Test1()

        Dim Sval As Range, wsUPI As Worksheet, wsA As Worksheet
        
Application.ScreenUpdating = False
        
        Set wsA = Sheets("Account_Movement")
        Set wsUPI = Sheets("UCT-Property Investment")
        Set Sval = wsUPI.Columns("A:A").Find(wsA.Range("F7").Value)
    
            If wsA.Range("F7").Value = Sval.Value Then
                    wsA.Range("V43").Copy
                    Sval.Offset(, 4).PasteSpecial xlValues
            End If

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

Hopefully we're on track now.

Cheerio,
vcoolio.
 
Wow vcoolio you are a star!

Your code works like a dream. Thank you so so much.
Once again sorry for all the trouble caused by the inaccurate info shared.

Regards
Peter
 
Hi Peter,
You're welcome. I'm glad to have been able to assist. We had to get there sooner or later!

BTW, it would be a good idea to remove that last sample workbook from the thread. It still has some "interesting" data in it. If you can't remove it yourself then please ask a Moderator to do it for you.

Also,
We could've trimmed the code further seeing that we don't need to deal with all the other sheets as well. That is:-

Code:
Option Explicit
Sub Test1()

        Dim Sval As Range, wsUPI As Worksheet, wsA As Worksheet
        
Application.ScreenUpdating = False
        
        Set wsA = Sheets("Account_Movement")
        Set wsUPI = Sheets("UCT-Property Investment")
        Set Sval = wsUPI.Columns("A:A").Find(wsA.Range("F7").Value)
    
                    wsA.Range("V43").Copy
                    Sval.Offset(, 4).PasteSpecial xlValues
          
Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

All the best Peter.

Cheerio,
vcoolio.
 
Last edited:
Back
Top