VBA Copy a row based upon 2 cells with 3 criteria

E

ez08mba

Board Regular
Joined
Nov 1, 2011
Messages
225
Office Version
  1. 2016
Platform
  1. Windows
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.

Code: 
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


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

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Sort by date Sort by votes
This worked for me....make sure the dates are actually dates

Code: 
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
 
Upvote 0
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.

Code: 
        If Cells(row, 5).Value = "Decommissioned" And Cells(row, 6).Value >= Date1 And _
                  Cells(row, 6).Value < Date2 Then
 
Upvote 0
What I meant was, make sure the cells are formatted correctly as dates, not as text, or other....anyway try
Code: 
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
 
Upvote 0
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"
Code: 
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
 
Upvote 0
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?

Code: 
If Cells(row, 5).Value = "Decommissioned" And Cells(row, 6).Value >= Date1 < Date2 Then
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Question Question
VBA code clean up
Replies
9
Views
482
mumps
mumps
Noid67
  • Question Question
Multiple worksheet change and Formula use
2
Replies
17
Views
690
mumps
mumps
Agnarr
  • Question Question
VBA problem with creating new sheets
Replies
0
Views
800
Agnarr
Agnarr
R
  • Question Question
Highlighting cells based on criteria
Replies
0
Views
396
rahildhody
R
D
  • Locked
  • Question Question
VBA to copy only matching data from 2 csv workbooks into the "Master Workbook"
Replies
1
Views
315
RoryA
RoryA

Forum statistics

Threads
1,223,244
Messages
6,170,976
Members
452,372
Latest member
Natalie18

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top