CODEWITHSUNDEEP
excelvba
Semih
Semih

Reputation: 21

Compare Dates on VBA

I'm trying to take items which have an earlier date.

When I run this code the output is the same as input. It tries to find the earlier items but it couldn't compare so all items are copied.

Private Sub Macro1()
a = Worksheets("SVS").Cells(Rows.Count, 1).End(xlUp).Row

For i = 3 To a

    If Worksheets("SVS").Cells(i, 22).Value < CDate("28/02/2023") Then
        Worksheets("SVS").Rows(i).Copy
        Worksheets("Summary").Activate
        b = Worksheets("Summary").Cells(Rows.Count, 1).End(xlUp).Row
        Worksheets("Summary").Cells(b + 1, 1).Select
        ActiveSheet.Paste
        Worksheets("SVS").Activate
    End If

Next i

Application.CutCopyMode = False

ThisWorkbook.Worksheets("SVS").Cells(1, 1).Select

End Sub

How do I get the earlier dates?

Upvotes: 2

Views: 103

Answers (2)

VBasic2008
VBasic2008

Reputation: 55073

Append If Earlier Date

Option Explicit

Sub AppendEarlierDate()

    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim sws As Worksheet: Set sws = wb.Sheets("SVS")
    Dim srg As Range
    Set srg = sws.Range("V3", sws.Cells(sws.Rows.Count, "V").End(xlUp))
    
    Dim surg As Range, sCell As Range, sValue
    
    For Each sCell In srg.Cells
        sValue = sCell.Value
        If IsDate(sValue) Then
            If sValue < DateSerial(2023, 2, 28) Then
                If surg Is Nothing Then
                    Set surg = sCell
                Else
                    Set surg = Union(surg, sCell)
                End If
            End If
        End If
    Next sCell
    
    If surg Is Nothing Then Exit Sub
    
    Dim dws As Worksheet: Set dws = wb.Sheets("Summary")
    If dws.FilterMode Then dws.ShowAllData 
    
    Dim dlCell As Range, dfCell As Range
    
    Set dlCell = dws.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious)
    If dlCell Is Nothing Then
        Set dfCell = dws.Range("A1")
    Else
        Set dfCell = dws.Cells(dlCell.Row + 1, "A")
    End If
    
    surg.EntireRow.Copy dfCell
    
End Sub

Upvotes: 0

CDP1802
CDP1802

Reputation: 16392

Check you have a valid date to compare with.

Option Explicit
Private Sub Macro1()

    Dim wb As Workbook, ws As Worksheet, v
    Dim lastrow As Long, i As Long, b As Long, n As Long
    
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Summary")
    b = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    With wb.Sheets("SVS")
        lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
    
        For i = 3 To lastrow
            v = .Cells(i, 22) ' col V
            If IsDate(v) Then
                If CDbl(v) < DateSerial(2023, 2, 28) Then
                    b = b + 1
                    .Rows(i).Copy ws.Cells(b, 1)
                    n = n + 1
                End If
            End If
        Next i
    End With
    MsgBox n & " rows copied to Summary", vbInformation, lastrow - 2 & " rows checked"
    
End Sub

Upvotes: 2

Related Questions