Why is this line of code not working? (1 Viewer)

raghuprabhu

Registered User.
Local time
Today, 11:25
Joined
Mar 24, 2008
Messages
154
Hi All,

My work has banned Access. Now I have to convert to Excel just when I am about to retire.

I am trying to select rows within a date range, with the value of "No" in the fourth column.

I have highlighted the line of code, not working.

Please, someone, tell me what I am doing wrong!

Code:
Sub CreateReport()
Dim sDate As Date
Dim tDate As Date
Dim PayDay As Date
Dim DueDate As Date
Dim PayCal As String
Dim LastRow As Integer
Dim i As Integer

Sheets("PayPeriod").Select

sDate = Range("G2").Value
tDate = Range("G3").Value
PayDay = Range("G4").Value
PayCal = Range("G5").Value

Sheets("Member_List").Select
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

    For i = 2 To LastRow
        DueDate = Cells(i, 2).Value
'********************************************************************************************************

            'If (DueDate >= sDate And DueDate <= tDate) And (Cells(i, 4).Value = "No") Then <<< not working!!!

'********************************************************************************************************

            If (DueDate >= sDate And DueDate <= tDate) Then 'And (Cells(i, 4).Value = "No") Then
                Range(Cells(i, 1), Cells(i, 4)).Copy
                Range("P100").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
                Application.CutCopyMode = False
                Cells(i, 4).Value = "Yes"
            End If
    Next i
End Sub

Regards

Raghu
 

Attachments

  • PrintReportV2.zip
    20.5 KB · Views: 86

boerbende

Ben
Local time
Today, 19:25
Joined
Feb 10, 2013
Messages
339
the code seems to run, but where do you initialize xlUp?
I guess you copy outside range because it gives me -4162
 

raghuprabhu

Registered User.
Local time
Today, 11:25
Joined
Mar 24, 2008
Messages
154
thanks...Boerbende...

Will try and initialise xlup properly and try again.

LastRow = ActiveSheet.Range("A1").CurrentRegion.Rows.Count
this worked perfectly!

Regards
Raghu
 
Last edited:

raghuprabhu

Registered User.
Local time
Today, 11:25
Joined
Mar 24, 2008
Messages
154
Hi Boerbende...

How do I modify the code above to give a message box, “15 (say) records have been updated”!
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Tomorrow, 02:25
Joined
May 7, 2009
Messages
19,169
Code:
Sub CreateReport()
Dim sDate As Date
Dim tDate As Date
Dim PayDay As Date
Dim DueDate As Date
Dim PayCal As String
Dim LastRow As Integer
Dim i As Integer

[COLOR=Blue]Dim lngCounter As Long[/COLOR]

Sheets("PayPeriod").Select

sDate = Range("G2").Value
tDate = Range("G3").Value
PayDay = Range("G4").Value
PayCal = Range("G5").Value

Sheets("Member_List").Select
LastRow = ActiveSheet.Range("A1").CurrentRegion.Rows.Count
    For i = 2 To LastRow
        DueDate = Cells(i, 2).Value
'********************************************************************************************************

            'If (DueDate >= sDate And DueDate <= tDate) And (Cells(i, 4).Value = "No") Then <<< not working!!!

'********************************************************************************************************

            If (DueDate >= sDate And DueDate <= tDate) Then 'And (Cells(i, 4).Value = "No") Then
                Range(Cells(i, 1), Cells(i, 4)).Copy
                Range("P100").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
                Application.CutCopyMode = False
                Cells(i, 4).Value = "Yes"
                
                [COLOR=Blue]lngCounter = lngCounter + 1[/COLOR]
            End If
    Next i
    MsgBox[COLOR=Blue] lngCounter[/COLOR] & " record(s) have been updated!"
End Sub
 

raghuprabhu

Registered User.
Local time
Today, 11:25
Joined
Mar 24, 2008
Messages
154
Hi all,

Although I marked this as "Solved", a small change in the coding, please! How do I change the code to paste the records into another worksheet called "Report"?

thank you

regards

Raghu
 

raghuprabhu

Registered User.
Local time
Today, 11:25
Joined
Mar 24, 2008
Messages
154
Sorted!

Code:
Private Sub AnotherSheet()
Dim sDate As Date
Dim tDate As Date
Dim PayDay As Date
Dim DueDate As Date
Dim PayCal As String
Dim LastRow As Integer
Dim i As Integer

Sheets("PayPeriod").Select

sDate = Range("G2").Value
tDate = Range("G3").Value
PayDay = Range("G4").Value
PayCal = Range("G5").Value

LastRow = Sheets("Member_List").Range("A" & Rows.Count).End(xlUp).Row
'Sheets("Report").Range("A2:C25").ClearContents
    
Sheets("Report").Select
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Name"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Due Date"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Amount"
    Range("A1:C1").Select
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
Sheets("Member_List").Select
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Name"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Due Date"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Amount"
    Range("A1:C1").Select
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    
LastRow = ActiveSheet.Range("A1").CurrentRegion.Rows.Count

    For i = 2 To LastRow
        DueDate = Cells(i, 2).Value
        If (DueDate >= sDate And DueDate <= tDate) And (Cells(i, 4).Value = "No") Then

'*******************************************************
'This line of code was causing the '1004' error
 
            Sheets("Member_List").Range(Cells(i, 1), Cells(i, 3)).Copy Destination:=Sheets("Report").Range("A" & Rows.Count).End(xlUp).Offset(1)
'*******************************************************
            Application.CutCopyMode = False
            Cells(i, 4).Value = "Yes"
            Cells(i, 5).Value = PayCal
        End If
    Next i
End Sub
 

Users who are viewing this thread

Top Bottom