+ Reply to Thread
Results 1 to 18 of 18

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

Hybrid View

  1. #1
    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

    Ok, I see what the problem is. Give me a bit to fix it, I'm pretty busy with my real job today.
    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

  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

    Ok, I rewrote your code. Here are a couple of issues:
    1) You don't need to select things. Look closely at how I reworked all the "Select" code to make it more efficient. It will run much faster this way.
    2) Your Frequency select between months cells don't work. The Month() function tells you what month the date you put in is in. For example, Month(Date) = 10 (October is the tenth month). Dates are stored as integers in excel. Since you put 1 and 3 in those cells, you are actually looking at 1/1/1900 and 1/3/1900. If you want to add a month, put 30 in those cells and just add the cell value instead of using the month code.
    3) The reason it was giving you this last error was the scope of the variable was local. To make it work, above both modules define it as public. For example: Public yourvariable as String.

    Go through this code and see the changes carefully. I put the revised code near the commented out lines of your code so you could see how they correspond. Then after, go ahead and delete out your code. If it is then not working properly, let me know and we'll tweak some more.

    Sub CheckPaySchSO()
    '
    ' Macro recorded 20/10/2009 by Philip Sharp
    Dim intLSORow As Integer 'Last cell in Standing Orders table
    Dim CellAddress As String
    Dim Today As Date
    Dim a As Integer
    
    Today = Date
    intLSORow = Sheets("CoA").Cells(47, "I").End(xlDown).Row
        
    Sheets("CoA").Activate
    
    'Do While ActiveCell.Value <> ""
    For a = 47 To intLSORow
        If Sheets("CoA").Cells(a, "I").Value < Today Then
        'If ActiveCell.Value < Today Then ' checks to see if contract date is before the present date - if yes go to next evaluation
            If Sheets("CoA").Cells(a, "P").Value = "" Then
            'If ActiveCell.Offset(0, 7).Value = "" Then ' if there is no previous accounting entry date then
                If Cells(a, "I").Value + Sheets("CoA").Cells(a, "J").Value < Today Then
                'If ActiveCell.Value + Month(ActiveCell.Offset(0, 1).Value) < Today Then ' if contract start plus one frequency period is before present date
                     'CellAddress = Sheets("CoA").Cells(a, "I").Address
                     Call enterdata(a)                   ' 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
                If Sheets("CoA").Cells(a, "P").Value + Sheets("CoA").Cells(a, "J").Value < Today Then
                     'CellAddress = ActiveCell.Address
                     Call enterdata(a)                   ' create entries on Receipts & Payments
                End If
            End If
        End If
    Next a
    
    End Sub
    
    Private Sub enterdata(intRowNum As Integer)
    
    Dim CellAddress As String
    Dim Today As Date
    Dim intNRPRow As Integer 'Next row in Receipts and Payments Table.
    
    Today = Date
    intNRPRow = Sheets("Receipts & Payments").Cells(10, "A").End(xlDown).Row + 1
    
    With Sheets("Receipts & Payments")
        .Cells(intNRPRow, 1).Value = Sheets("CoA").Cells(intRowNum, "I").Value
        .Cells(intNRPRow, 2).Value = Sheets("CoA").Cells(intRowNum, "K").Value
        .Cells(intNRPRow, 3).Value = Sheets("CoA").Cells(intRowNum, "L").Value
        .Cells(intNRPRow, 4).Value = Sheets("CoA").Cells(intRowNum, "N").Value
        .Cells(intNRPRow, 5).Value = Sheets("CoA").Cells(intRowNum, "M").Value
        .Cells(intNRPRow, 11).Value = Sheets("CoA").Cells(intRowNum, "O").Value
    End With
    
    
    '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").Range(CellAddress).Value
    '    ActiveCell.Offset(0, 1) = Sheets("CoA").Range(CellAddress).Offset(0, 2).Value
    '    ActiveCell.Offset(0, 2) = Sheets("CoA").Range(CellAddress).Offset(0, 3).Value
    '    ActiveCell.Offset(0, 3) = Sheets("CoA").Range(CellAddress)(0, 5).Value
    '    ActiveCell.Offset(0, 4) = Sheets("CoA").Range(CellAddress).Offset(0, 4).Value
    '    ActiveCell.Offset(0, 10) = Sheets("CoA").Range(CellAddress).Offset(0, 6).Value
    '
    '    ActiveWorkbook.Sheets("CoA").Activate
    '    Range("I47").Select
     
    'If ActiveCell.Value + Month(ActiveCell.Offset(0, 1).Value) < Today Then
    If Sheets("CoA").Cells(intRowNum, "I").Value + Sheets("CoA").Cells(intRowNum, "J").Value < Today Then
            'ActiveCell.Offset(0, 7).Value = ActiveCell.Value + Month(ActiveCell.Offset(0, 1).Value)
             Sheets("CoA").Cells(intRowNum, "P").Value = Sheets("CoA").Cells(intRowNum, "I").Value + Sheets("CoA").Cells(intRowNum, "J").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)
    Else: Sheets("CoA").Cells(intRowNum, "P").Value = Sheets("CoA").Cells(intRowNum, "P") + Sheets("CoA").Cells(intRowNum, "J").Value
                                
    End If
                    
    End Sub

+ 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