+ Reply to Thread
Results 1 to 18 of 18

copy cells from sheets based on date, paste to another sheet

Hybrid View

  1. #1
    Registered User
    Join Date
    06-09-2008
    Posts
    28

    Re: copy cells from sheets based on date, paste to another sheet

    Quote Originally Posted by davegugg View Post
    ...Today would always be > txbDate.value, unless that value is tomorrow or later. ...
    Although true for most cases it is possible for the user to set up the schedule for future commitments.

  2. #2
    Forum Expert davegugg's Avatar
    Join Date
    12-18-2008
    Location
    WI, US
    MS-Off Ver
    2010
    Posts
    1,884

    Re: copy cells from sheets based on date, paste to another sheet

    Quote Originally Posted by upod View Post
    Although true for most cases it is possible for the user to set up the schedule for future commitments.

    I just want to be sure you understand what happens when the current date is put into cbxDate.
    Is your code running too slowly?
    Does your workbook or database have a bunch of duplicate pieces of data?
    Have a look at this article to learn the best ways to set up your projects.
    It will save both time and effort in the long run!


    Dave

  3. #3
    Registered User
    Join Date
    06-09-2008
    Posts
    28

    Re: copy cells from sheets based on date, paste to another sheet

    Well I am not sure the suggestions are helping (tbxDate, not txbDate) but I am getting a 1004 error "method select of object range failed" pointing at Range("I47").Select, the fifth line of code on the worksheet change

    At the risk of repeating myself there are 2 distinct events; the first when the user sets up a schedule of future payment commitments, and the second based on a worksheet change. Because the first event makes an entry on the Receipts and Payments worksheet it triggers the second event, where it seems the problem lies.

    After making the changes suggested by davegugg i have the following for the input form entries (have removed the error messages for empty textboxes and initialize ;
    Private Sub CmdBtnOK_Click()
    
    Dim Today
    Today = Date
    
    
    
    ActiveWorkbook.Sheets("CoA").Activate
    Range("i47").Select
    
        Do
            If IsEmpty(ActiveCell) = False Then
                ActiveCell.Offset(1, 0).Select
            End If
    
        Loop Until IsEmpty(ActiveCell) = True
        
        ActiveCell.Value = tbxDate.Value
        ActiveCell.Offset(0, 1) = cbxFreq.Value
        ActiveCell.Offset(0, 2) = tbxTo.Value
        ActiveCell.Offset(0, 3) = tbxDesc.Value
        ActiveCell.Offset(0, 4) = tbxRef.Value
        ActiveCell.Offset(0, 5) = cbxAccount.Value
        ActiveCell.Offset(0, 6) = tbxAmount.Value
    
    
    If CDate(tbxDate.Value) < Today Then
    
    ActiveCell.Offset(0, 7) = tbxDate.Value ' to record on CoA first entry (below)
    
    ActiveWorkbook.Sheets("Receipts & Payments").Activate
    Range("a10").Select
    
        Do
            If IsEmpty(ActiveCell) = False Then
                ActiveCell.Offset(1, 0).Select
            End If
    
        Loop Until IsEmpty(ActiveCell) = True
        
        ActiveCell.Value = tbxDate.Value
        ActiveCell.Offset(0, 1) = tbxTo.Value
        ActiveCell.Offset(0, 2) = tbxDesc.Value
        ActiveCell.Offset(0, 3) = cbxAccount.Value
        ActiveCell.Offset(0, 4) = tbxRef.Value
        ActiveCell.Offset(0, 10) = tbxAmount.Value
    End If
    
    End Sub
    and this is the revised code for the Receipts & Payments (sheet 9) change event
    Private Sub Worksheet_Change(ByVal Target As Excel.Range)
        
    Dim Today
    Today = Date
        
        Sheets("CoA").Select
        Range("I47").Select
    
        Do While ActiveCell.Value <> ""
            
            If ActiveCell.Value < Today Then ' checks to see if contract date is before the present date - if yes go to next evaluation
            
                If ActiveCell.Offset(0, 7).Value = "" Then ' if there is no previous accounting entry date then
                    
                    If ActiveCell.Value + Month(ActiveCell.Offset(0, 1).Value) < Today Then ' if contract start plus one frequency period is before present date
                         Call enterdata                   ' create entries on Receipts & Payments
                                        
                    End If
                    
                Else
                    If ActiveCell.Offset(0, 7).Value + Month(ActiveCell.Offset(0, 1).Value) < Today Then    ' if last entry plus one frequency period is before present date
        
                         Call enterdata                   ' create entries on Receipts & Payments
                    End If
                End If
            End If
        
        ActiveCell.Offset(1, 0).Select 'evaluate next row
            
        Loop ' Until IsEmpty(ActiveCell) = True
        
        Exit Sub
    
    End Sub
    
    Private Sub enterdata()
    
    ActiveWorkbook.Sheets("Receipts & Payments").Activate
    Range("a10").Select
    
        Do
        If IsEmpty(ActiveCell) = False Then
        ActiveCell.Offset(1, 0).Select
        End If
    
        Loop Until IsEmpty(ActiveCell) = True
    
        ActiveCell.Value = Sheets("CoA").ActiveCell.Value
        ActiveCell.Offset(0, 1) = Sheets("CoA").ActiveCell.Offset(2, 0).Value
        ActiveCell.Offset(0, 2) = Sheets("CoA").ActiveCell.Offset(3, 0).Value
        ActiveCell.Offset(0, 3) = Sheets("CoA").ActiveCellOffset(5, 0).Value
        ActiveCell.Offset(0, 4) = Sheets("CoA").ActiveCell.Offset(4, 0).Value
        ActiveCell.Offset(0, 10) = Sheets("CoA").ActiveCell.Offset(6, 0).Value
        
        ActiveWorkbook.Sheets("CoA").Activate
     
            If ActiveCell.Value + Month(ActiveCell.Offset(0, 1).Value) < Today Then
                    ActiveCell.Offset(0, 7).Value = ActiveCell.Value + Month(ActiveCell.Offset(0, 1).Value)
                    ' if contract start plus one frequency period is before present date
            Else: ActiveCell.Offset(0, 7).Value = ActiveCell.Offset(0, 7).Value + Month(ActiveCell.Offset(0, 1).Value)
                                        
            End If
                    
    
    
    End Sub
    Have I adequately explained the problem? I would appreciate any help on this.

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1