VBA Copy a row based upon 2 cells with 3 criteria

[ez08mba]

I'm not sure why this doesn't work on the dummy data?

Problems:

1. It doesn't recognize the September 2011 dates
2. It is supposed to pull dates between July and August (i.e. 2 dates) and pull everything except those dates.

The date strings have to be variable based since it can't be hard coded.

Sub copyrow()
Dim rc As Integer, row As Integer, i As Integer
Dim mm As String, fdt As String, pdt As String, mo As String, yr As String
Dim Date1 As String, Date2 As String
     mm = Month(Date) - 1
     mo = Format(Now(), "mm")  'ex. "08"
     yr = Format(Now(), "yyyy")
     Date1 = mm & "/01/" & yr
     Date2 = mo & "/01/" & yr

     With Worksheets(1).Activate
          rc = Cells(Rows.Count, 1).End(xlUp).row
          For row = rc To 1 Step -1
               If Cells(row, 5).Value = "Decommissioned" And _
                     Cells(row, 6).Value < Date1 And _
                         Cells(row, 6).Value >= Date2 Then
                    
                         Rows(row).EntireRow.Copy
                              Worksheets(2).Activate
                              Range("A1").Select
                              i = Cells(Rows.Count, 1).End(xlUp).row + 1
                              Cells(i, 1).Select
                              ActiveSheet.Paste
                              Worksheets(1).Activate
               End If
          Next
     End With

End Sub

Dept</SPAN>	Application Id</SPAN>	Application Name</SPAN>	Short Name</SPAN>	State</SPAN>	Decommission Date</SPAN>
IT</SPAN>	ID11</SPAN>	App17</SPAN>	O</SPAN>	Operate</SPAN>	12/15/2012 0:00</SPAN>
IT</SPAN>	ID12</SPAN>	App18</SPAN>	P</SPAN>	Operate</SPAN>	12/15/2012 0:00</SPAN>
IT</SPAN>	ID17</SPAN>	App16</SPAN>	S</SPAN>	Retired</SPAN>	7/31/2012 0:00</SPAN>
IT</SPAN>	ID6</SPAN>	App14</SPAN>	E</SPAN>	Decommissioned</SPAN>	7/3/2012 0:00</SPAN>
IT</SPAN>	ID18</SPAN>	App15</SPAN>	F</SPAN>	Decommissioned</SPAN>	7/3/2012 0:00</SPAN>
IT</SPAN>	ID8</SPAN>	App12</SPAN>	C</SPAN>	Decommissioned</SPAN>	6/27/2012 0:00</SPAN>
IT</SPAN>	ID5</SPAN>	App13</SPAN>	D</SPAN>	Decommissioned</SPAN>	6/27/2012 0:00</SPAN>
IT</SPAN>	ID2</SPAN>	App11</SPAN>	B</SPAN>	Decommissioned</SPAN>	6/19/2012 0:00</SPAN>
IT</SPAN>	ID19</SPAN>	App10</SPAN>	A</SPAN>	Decommissioned</SPAN>	5/10/2012 0:00</SPAN>
IT</SPAN>	ID16</SPAN>	App7</SPAN>	L</SPAN>	Decommissioned</SPAN>	4/18/2012 0:00</SPAN>
IT</SPAN>	ID9</SPAN>	App8</SPAN>	M</SPAN>	Decommissioned</SPAN>	4/18/2012 0:00</SPAN>
IT</SPAN>	ID14</SPAN>	App9</SPAN>	N</SPAN>	Decommissioned</SPAN>	4/18/2012 0:00</SPAN>
IT</SPAN>	ID4</SPAN>	App5</SPAN>	J</SPAN>	Decommissioned</SPAN>	2/29/2012 0:00</SPAN>
IT</SPAN>	ID10</SPAN>	App6</SPAN>	K</SPAN>	Decommissioned</SPAN>	2/29/2012 0:00</SPAN>
IT</SPAN>	ID7</SPAN>	App4</SPAN>	I</SPAN>	Decommissioned</SPAN>	12/19/2011 0:00</SPAN>
IT</SPAN>	ID13</SPAN>	App2</SPAN>	G</SPAN>	Decommissioned</SPAN>	9/28/2011 0:00</SPAN>
IT</SPAN>	ID15</SPAN>	App3</SPAN>	H</SPAN>	Decommissioned</SPAN>	9/28/2011 0:00</SPAN>
IT</SPAN>	ID3</SPAN>	App1</SPAN>	R</SPAN>	Retired</SPAN>	9/1/2011 0:00</SPAN>
IT</SPAN>	ID1</SPAN>	App19</SPAN>	Q</SPAN>	Operate</SPAN>

<TBODY>
</TBODY><COLGROUP><COL><COL><COL><COL><COL><COL></COLGROUP>

 

[Michael M]

This worked for me....make sure the dates are actually dates

Sub copyrow()
Dim rc As Integer, row As Integer, i As Integer
Dim mm As String, fdt As String, pdt As String, mo As String, yr As String
Dim Date1 As String, Date2 As String
     mm = Month(Date) - 1
     mo = Format(Now(), "mm")  'ex. "08"
     yr = Format(Now(), "yyyy")
     Date1 = mm & "/01/" & yr
     Date2 = mo & "/01/" & yr
i = Worksheets(2).Cells(Rows.Count, 1).End(xlUp).row + 1
With Worksheets(1).Activate
     rc = Cells(Rows.Count, 1).End(xlUp).row
    For row = rc To 1 Step -1
        If Cells(row, 5).Value = "Decommissioned" And Cells(row, 6).Value < Date1 And _
                  Cells(row, 6).Value >= Date2 Then
                Rows(row).EntireRow.Copy Destination:=Worksheets(2).Rows(i)
        End If
        i = Worksheets(2).Cells(Rows.Count, 1).End(xlUp).row + 1
    Next
End With
End Sub

 

[ez08mba]

Hi Michael, sorry about posting twice.

I'm not sure why, but that didn't work for me? I don't doubt the code, but I'm not sure why it doesn't. I still get the same results I got before. I still don't understand what you mean by "using actual dates"? Can you explain why you think they aren't?

BTW, this is correct, I had the date range entered wrong when I posted before.

        If Cells(row, 5).Value = "Decommissioned" And Cells(row, 6).Value >= Date1 And _
                  Cells(row, 6).Value < Date2 Then

 

[Michael M]

What I meant was, make sure the cells are formatted correctly as dates, not as text, or other....anyway try

Sub copyrow()
Dim rc As Integer, row As Integer, i As Integer
Dim mm As String, fdt As String, pdt As String, mo As String, yr As String
Dim Date1 As String, Date2 As String
     mm = Month(Date) - 1
     mo = Format(Now(), "mm")  'ex. "08"
     yr = Format(Now(), "yyyy")
     Date1 = mm & "/01/" & yr
     Date2 = mo & "/01/" & yr
i = Worksheets(2).Cells(Rows.Count, 1).End(xlUp).row + 1
With Worksheets(1).Activate
     rc = Cells(Rows.Count, 1).End(xlUp).row
    For row = rc To 1 Step -1
        Rows(row).Select
        If Cells(row, 5).Value = "Decommissioned" And Cells(row, 6).Value >= Date1 Or _
                  Cells(row, 6).Value < Date2 Then
                Rows(row).EntireRow.Copy Destination:=Worksheets(2).Rows(i)
        End If
        i = Worksheets(2).Cells(Rows.Count, 1).End(xlUp).row + 1
    Next
End With
End Sub

 

[Michael M]

Darn....made a typo
If you hover your mouse over the variable mm in your code, you will see that it is "7", not "07"

Sub copyrow()
Dim rc As Long, row As Long, i As Long
Dim mm As String, mo As String, yr As String
Dim Date1 As String, Date2 As String
     mm = Format(DateAdd("m", -1, Date), "mm")
     mo = Format(Date, "mm")  'ex. "08"
     yr = Format(Date, "yyyy")
     Date1 = mm & "/01/" & yr
     Date2 = mo & "/01/" & yr
i = Worksheets(2).Cells(Rows.Count, 1).End(xlUp).row + 1
With Worksheets(1).Activate
     rc = Cells(Rows.Count, 1).End(xlUp).row
    For row = rc To 2 Step -1
        If Cells(row, 5).Value = "Decommissioned" And Cells(row, 6).Value < Date2 And _
                 Cells(row, 6).Value >= Date1 Then
                Rows(row).EntireRow.Copy Destination:=Worksheets(2).Rows(i)
        End If
        i = Worksheets(2).Cells(Rows.Count, 1).End(xlUp).row + 1
    Next
End With
End Sub

 

[ez08mba]

Hi Michael:

Thanks for clarifying. Ok, this works, but it is only supposed to pull data between a date range. This is how I "think" the line is supposed to be. However, It doesn't pull anything. If I just use the "Greater than" (in this case 7/1/2012), it pulls the July 3, 2012 and the for some reason the 9/28/2011 dates? Not sure why?

Any thoughts?

If Cells(row, 5).Value = "Decommissioned" And Cells(row, 6).Value >= Date1 < Date2 Then