Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
SearchDate
Sub SearchDate()
Dim Cell As Range Dim CheckDate As Date Dim DstRng As Range Dim NextRow As Long Dim Rng As Range Dim RngEnd As Range Dim SrcRng As Range CheckDate = Int(Now()) - 30 Set SrcRng = Worksheets("Sheet1").Range("B2") Set DstRng = Worksheets("Sheet2").Range("A2") Set RngEnd = SrcRng.Parent.Cells(Rows.Count, SrcRng.Column).End(xlUp) Set SrcRng = IIf(RngEnd.Row < SrcRng.Row, SrcRng, SrcRng.Parent.Range(SrcRng, RngEnd)) Set RngEnd = DstRng.Parent.Cells(Rows.Count, DstRng.Column).End(xlUp) Set DstRng = IIf(RngEnd.Row < DstRng.Row, DstRng, RngEnd.Offset(1, 0)) For Each Cell In SrcRng If Cell = CheckDate And Cell <= Int(Now()) Then If Rng Is Nothing Then Set Rng = Cell Set Rng = Union(Rng, Cell) Cell.EntireRow.Copy DstRng.Offset(NextRow, 0) NextRow = NextRow + 1 End If Next Cell If Not Rng Is Nothing Then Rng.EntireRow.Delete End Sub This code looks in every row of Sheet 1/Column B for a date that is less than or equal to 30 days from todays date. When a date in Column B matches that criterion the entire row that the date is in is transferred to a new row in Sheet2. I would like to change the search criterion and I am looking for help. I would like the macro to look for a date that is 30 days before todays date first (today it would be 6/17/09). Once that date is identified then I would like the macro to look in every row of Sheet1/Column B for every date that is less than or equal 30 days before that date; when those dates are found I would like to transfer them and their rows only to Sheet2 into a new row. If you can help, thank you. |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
SearchDate
On Jul 17, 3:11*pm, Jazz wrote:
Sub SearchDate() * Dim Cell As Range * Dim CheckDate As Date * Dim DstRng As Range * Dim NextRow As Long * Dim Rng As Range * Dim RngEnd As Range * Dim SrcRng As Range * * CheckDate = Int(Now()) - 30 * * Set SrcRng = Worksheets("Sheet1").Range("B2") * * Set DstRng = Worksheets("Sheet2").Range("A2") * * Set RngEnd = SrcRng.Parent.Cells(Rows.Count, SrcRng.Column).End(xlUp) * * Set SrcRng = IIf(RngEnd.Row < SrcRng.Row, SrcRng, SrcRng.Parent.Range(SrcRng, RngEnd)) * * Set RngEnd = DstRng.Parent.Cells(Rows.Count, DstRng.Column).End(xlUp) * * Set DstRng = IIf(RngEnd.Row < DstRng.Row, DstRng, RngEnd.Offset(1, 0)) * * * For Each Cell In SrcRng * * * * If Cell = CheckDate And Cell <= Int(Now()) Then * * * * * If Rng Is Nothing Then Set Rng = Cell * * * * * Set Rng = Union(Rng, Cell) * * * * *Cell.EntireRow.Copy DstRng.Offset(NextRow, 0) * * * * *NextRow = NextRow + 1 * * * * End If * * * Next Cell * * If Not Rng Is Nothing Then Rng.EntireRow.Delete End Sub This code looks in every row of Sheet 1/Column B for a date that is less than or equal to 30 days from today’s date. *When a date in Column B matches that criterion the entire row that the date is in is transferred to a new row in Sheet2. * I would like to change the search criterion and I am looking for help. *I would like the macro to look for a date that is 30 days before today’s date first (today it would be 6/17/09). *Once that date is identified then I would like the macro to look in every row of Sheet1/Column B for every date that is less than or equal 30 days before that date; when those dates are found I would like to transfer them and their rows only to Sheet2 into a new row. *If you can help, thank you. * Jazz, It appears that you are already making that comparison (unless I've drastically missed something). The code below lists the following: Cell = CheckDate And Cell <= TodayDate; or in other words, Cell = 6/17/09 And Cell <= 7/17/09. As you stated, this is "30 days before today's date". I added another variable (TodayDate) and moved some of the code from the For Each loop to the If Then statement below the For Each loop. (An alternative method would be to use the Find method to create a unioned range of dates found. See the VBE help files for "Find Method" for more details). Also, if you want "every" row in Column B, then change your SrcRng to Set SrcRng = Columns("B"). Best, Matthew Herbert Sub SearchDate() Dim Cell As Range Dim CheckDate As Date Dim TodayDate As Date Dim DstRng As Range Dim NextRow As Long Dim Rng As Range Dim RngEnd As Range Dim SrcRng As Range Dim rngFound As Range TodayDate = Int(Now()) CheckDate = TodayDate - 30 Set SrcRng = Worksheets("Sheet1").Range("B2") Set DstRng = Worksheets("Sheet2").Range("A2") Set RngEnd = SrcRng.Parent.Cells(Rows.Count, SrcRng.Column).End(xlUp) Set SrcRng = IIf(RngEnd.Row < SrcRng.Row, SrcRng, SrcRng.Parent.Range (SrcRng, RngEnd)) Set RngEnd = DstRng.Parent.Cells(Rows.Count, DstRng.Column).End(xlUp) Set DstRng = IIf(RngEnd.Row < DstRng.Row, DstRng, RngEnd.Offset(1, 0)) For Each Cell In SrcRng If Cell = CheckDate And Cell <= TodayDate Then If Rng Is Nothing Then Set Rng = Cell Set Rng = Union(Rng, Cell) End If Next Cell If Not Rng Is Nothing Then Rng.EntireRow.Copy DstRng Rng.EntireRow.Delete End If End Sub |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
SearchDate
Jazz- While I think I understand what you are asking, I'm not sure you've
provided enough information about your requirements - please see the following example(s) Today's date = n First date parameter = n-30 Sample dates: n-15 n-25 n-29 n-50 In your given scenario, it would find the first value (n-15) then look for anything that is within 30 days prior (e.g. between n-45 and n-15). Therefore, it would move rows 2 and 3 to your second sheet. When it reaches row 4, it would skip that record because n-50 is less than n-45. As the program iterates through rows, it would also skip n-50 on an outer loop, because it is outside of your original n-30 criteria. However, if the dates are not in ascending order, maybe you start with: n-25 n-15 n-50 n-29 in which case, when you hit n-25 you would generate criteria looking for anything between n-55 to n-25, and you would grab both the n-50 and n-29 (in the previous example, you didn't grab n-50). Having your results be dependent on the order of items in your worksheet may produce less predictable results. If the dates were in reverse order: n-50 n-29 n-25 n-15 Then if your inner loop starts at the current outer loop position, it would never return anything at all, because there would never be any older dates below the current record. If the inner loop needs to loop all values (including the ones already processed by the outer loop) I see even more opportunity for confusing results... Anyway, it might be worth providing a little more detail about what the date ranges represent to your analysis, and what you are trying to accomplish with pulling over certain items based on their date relationship to other items, so we can do a better job of making suggestions that will meet your needs. :) "Jazz" wrote: Sub SearchDate() Dim Cell As Range Dim CheckDate As Date Dim DstRng As Range Dim NextRow As Long Dim Rng As Range Dim RngEnd As Range Dim SrcRng As Range CheckDate = Int(Now()) - 30 Set SrcRng = Worksheets("Sheet1").Range("B2") Set DstRng = Worksheets("Sheet2").Range("A2") Set RngEnd = SrcRng.Parent.Cells(Rows.Count, SrcRng.Column).End(xlUp) Set SrcRng = IIf(RngEnd.Row < SrcRng.Row, SrcRng, SrcRng.Parent.Range(SrcRng, RngEnd)) Set RngEnd = DstRng.Parent.Cells(Rows.Count, DstRng.Column).End(xlUp) Set DstRng = IIf(RngEnd.Row < DstRng.Row, DstRng, RngEnd.Offset(1, 0)) For Each Cell In SrcRng If Cell = CheckDate And Cell <= Int(Now()) Then If Rng Is Nothing Then Set Rng = Cell Set Rng = Union(Rng, Cell) Cell.EntireRow.Copy DstRng.Offset(NextRow, 0) NextRow = NextRow + 1 End If Next Cell If Not Rng Is Nothing Then Rng.EntireRow.Delete End Sub This code looks in every row of Sheet 1/Column B for a date that is less than or equal to 30 days from todays date. When a date in Column B matches that criterion the entire row that the date is in is transferred to a new row in Sheet2. I would like to change the search criterion and I am looking for help. I would like the macro to look for a date that is 30 days before todays date first (today it would be 6/17/09). Once that date is identified then I would like the macro to look in every row of Sheet1/Column B for every date that is less than or equal 30 days before that date; when those dates are found I would like to transfer them and their rows only to Sheet2 into a new row. If you can help, thank you. |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
SearchDate
Hi Matt,
From the feedback I got I realized that I wasnt entirely clear. My apologies. What I am trying to do, whenever I run the macro, is get the date which is 30 days from todays date. Once I have found that date. I want to grab all the dates that are less than or equal to 30 days from the new date. For example, lets say I ran the macro today. This is what I want to have happen 1. Today is 7/19/09 2. 30 days before 7/19/09 is 6/19/09 3. Here are all the rows in Sheet1 with dates in Column B that are less than or equal to 30 days before 6/19/09; next the list gets pasted into Sheet2. Please let me know if there is still any ambiguity. Yes you are correct, if I want every row in Column B I should say SrcRng = Columns("B"). Thank again for your help. Regards, Jazz P.S. Your modifications to the macro are really good. "Matthew Herbert" wrote: On Jul 17, 3:11 pm, Jazz wrote: Sub SearchDate() Dim Cell As Range Dim CheckDate As Date Dim DstRng As Range Dim NextRow As Long Dim Rng As Range Dim RngEnd As Range Dim SrcRng As Range CheckDate = Int(Now()) - 30 Set SrcRng = Worksheets("Sheet1").Range("B2") Set DstRng = Worksheets("Sheet2").Range("A2") Set RngEnd = SrcRng.Parent.Cells(Rows.Count, SrcRng.Column).End(xlUp) Set SrcRng = IIf(RngEnd.Row < SrcRng.Row, SrcRng, SrcRng.Parent.Range(SrcRng, RngEnd)) Set RngEnd = DstRng.Parent.Cells(Rows.Count, DstRng.Column).End(xlUp) Set DstRng = IIf(RngEnd.Row < DstRng.Row, DstRng, RngEnd.Offset(1, 0)) For Each Cell In SrcRng If Cell = CheckDate And Cell <= Int(Now()) Then If Rng Is Nothing Then Set Rng = Cell Set Rng = Union(Rng, Cell) Cell.EntireRow.Copy DstRng.Offset(NextRow, 0) NextRow = NextRow + 1 End If Next Cell If Not Rng Is Nothing Then Rng.EntireRow.Delete End Sub This code looks in every row of Sheet 1/Column B for a date that is less than or equal to 30 days from todays date. When a date in Column B matches that criterion the entire row that the date is in is transferred to a new row in Sheet2. I would like to change the search criterion and I am looking for help. I would like the macro to look for a date that is 30 days before todays date first (today it would be 6/17/09). Once that date is identified then I would like the macro to look in every row of Sheet1/Column B for every date that is less than or equal 30 days before that date; when those dates are found I would like to transfer them and their rows only to Sheet2 into a new row. If you can help, thank you. Jazz, It appears that you are already making that comparison (unless I've drastically missed something). The code below lists the following: Cell = CheckDate And Cell <= TodayDate; or in other words, Cell = 6/17/09 And Cell <= 7/17/09. As you stated, this is "30 days before today's date". I added another variable (TodayDate) and moved some of the code from the For Each loop to the If Then statement below the For Each loop. (An alternative method would be to use the Find method to create a unioned range of dates found. See the VBE help files for "Find Method" for more details). Also, if you want "every" row in Column B, then change your SrcRng to Set SrcRng = Columns("B"). Best, Matthew Herbert Sub SearchDate() Dim Cell As Range Dim CheckDate As Date Dim TodayDate As Date Dim DstRng As Range Dim NextRow As Long Dim Rng As Range Dim RngEnd As Range Dim SrcRng As Range Dim rngFound As Range TodayDate = Int(Now()) CheckDate = TodayDate - 30 Set SrcRng = Worksheets("Sheet1").Range("B2") Set DstRng = Worksheets("Sheet2").Range("A2") Set RngEnd = SrcRng.Parent.Cells(Rows.Count, SrcRng.Column).End(xlUp) Set SrcRng = IIf(RngEnd.Row < SrcRng.Row, SrcRng, SrcRng.Parent.Range (SrcRng, RngEnd)) Set RngEnd = DstRng.Parent.Cells(Rows.Count, DstRng.Column).End(xlUp) Set DstRng = IIf(RngEnd.Row < DstRng.Row, DstRng, RngEnd.Offset(1, 0)) For Each Cell In SrcRng If Cell = CheckDate And Cell <= TodayDate Then If Rng Is Nothing Then Set Rng = Cell Set Rng = Union(Rng, Cell) End If Next Cell If Not Rng Is Nothing Then Rng.EntireRow.Copy DstRng Rng.EntireRow.Delete End If End Sub |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
SearchDate
Hi Ker,
Thank you for your feedback. You made some really good points. I think I need to think through what I am saying a little bit more to make sure it is more thorough. However, in the meantime, perhaps this explanation may provide a little more clarity For example, lets say I ran the macro today. This is what I want to have happen 1. Today is 7/19/09 2. 30 days before 7/19/09 is 6/19/09 3. Here are all the rows in Sheet1 with dates in Column B that are less than or equal to 30 days before 6/19/09; next the list gets pasted into Sheet2. Thanks again, Regards, Jazz "ker_01" wrote: Jazz- While I think I understand what you are asking, I'm not sure you've provided enough information about your requirements - please see the following example(s) Today's date = n First date parameter = n-30 Sample dates: n-15 n-25 n-29 n-50 In your given scenario, it would find the first value (n-15) then look for anything that is within 30 days prior (e.g. between n-45 and n-15). Therefore, it would move rows 2 and 3 to your second sheet. When it reaches row 4, it would skip that record because n-50 is less than n-45. As the program iterates through rows, it would also skip n-50 on an outer loop, because it is outside of your original n-30 criteria. However, if the dates are not in ascending order, maybe you start with: n-25 n-15 n-50 n-29 in which case, when you hit n-25 you would generate criteria looking for anything between n-55 to n-25, and you would grab both the n-50 and n-29 (in the previous example, you didn't grab n-50). Having your results be dependent on the order of items in your worksheet may produce less predictable results. If the dates were in reverse order: n-50 n-29 n-25 n-15 Then if your inner loop starts at the current outer loop position, it would never return anything at all, because there would never be any older dates below the current record. If the inner loop needs to loop all values (including the ones already processed by the outer loop) I see even more opportunity for confusing results... Anyway, it might be worth providing a little more detail about what the date ranges represent to your analysis, and what you are trying to accomplish with pulling over certain items based on their date relationship to other items, so we can do a better job of making suggestions that will meet your needs. :) "Jazz" wrote: Sub SearchDate() Dim Cell As Range Dim CheckDate As Date Dim DstRng As Range Dim NextRow As Long Dim Rng As Range Dim RngEnd As Range Dim SrcRng As Range CheckDate = Int(Now()) - 30 Set SrcRng = Worksheets("Sheet1").Range("B2") Set DstRng = Worksheets("Sheet2").Range("A2") Set RngEnd = SrcRng.Parent.Cells(Rows.Count, SrcRng.Column).End(xlUp) Set SrcRng = IIf(RngEnd.Row < SrcRng.Row, SrcRng, SrcRng.Parent.Range(SrcRng, RngEnd)) Set RngEnd = DstRng.Parent.Cells(Rows.Count, DstRng.Column).End(xlUp) Set DstRng = IIf(RngEnd.Row < DstRng.Row, DstRng, RngEnd.Offset(1, 0)) For Each Cell In SrcRng If Cell = CheckDate And Cell <= Int(Now()) Then If Rng Is Nothing Then Set Rng = Cell Set Rng = Union(Rng, Cell) Cell.EntireRow.Copy DstRng.Offset(NextRow, 0) NextRow = NextRow + 1 End If Next Cell If Not Rng Is Nothing Then Rng.EntireRow.Delete End Sub This code looks in every row of Sheet 1/Column B for a date that is less than or equal to 30 days from todays date. When a date in Column B matches that criterion the entire row that the date is in is transferred to a new row in Sheet2. I would like to change the search criterion and I am looking for help. I would like the macro to look for a date that is 30 days before todays date first (today it would be 6/17/09). Once that date is identified then I would like the macro to look in every row of Sheet1/Column B for every date that is less than or equal 30 days before that date; when those dates are found I would like to transfer them and their rows only to Sheet2 into a new row. If you can help, thank you. |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
SearchDate
On Jul 19, 12:28*pm, Jazz wrote:
Hi Matt, From the feedback I got I realized that I wasn’t entirely clear. *My apologies. *What I am trying to do, whenever I run the macro, is get the date which is 30 day’s from today’s date. *Once I have found that date. *I want to grab all the dates that are less than or equal to 30 days from the new date. For example, lets say I ran the macro today. *This is what I want to have happen 1. * * *Today is 7/19/09 2. * * *30 days before 7/19/09 is 6/19/09 3. * * *Here are all the rows in Sheet1 with dates in Column B that are less than * * * * * * * * or equal to 30 days before 6/19/09; next the list gets pasted into Sheet2. Please let me know if there is still any ambiguity. *Yes you are correct, if I want every row in Column B I should say SrcRng = Columns("B"). *Thank again for your help. Regards, Jazz P.S. *Your modifications to the macro are really good. "Matthew Herbert" wrote: On Jul 17, 3:11 pm, Jazz wrote: Sub SearchDate() * Dim Cell As Range * Dim CheckDate As Date * Dim DstRng As Range * Dim NextRow As Long * Dim Rng As Range * Dim RngEnd As Range * Dim SrcRng As Range * * CheckDate = Int(Now()) - 30 * * Set SrcRng = Worksheets("Sheet1").Range("B2") * * Set DstRng = Worksheets("Sheet2").Range("A2") * * Set RngEnd = SrcRng.Parent.Cells(Rows.Count, SrcRng.Column)..End(xlUp) * * Set SrcRng = IIf(RngEnd.Row < SrcRng.Row, SrcRng, SrcRng.Parent.Range(SrcRng, RngEnd)) * * Set RngEnd = DstRng.Parent.Cells(Rows.Count, DstRng.Column)..End(xlUp) * * Set DstRng = IIf(RngEnd.Row < DstRng.Row, DstRng, RngEnd.Offset(1, 0)) * * * For Each Cell In SrcRng * * * * If Cell = CheckDate And Cell <= Int(Now()) Then * * * * * If Rng Is Nothing Then Set Rng = Cell * * * * * Set Rng = Union(Rng, Cell) * * * * *Cell.EntireRow.Copy DstRng.Offset(NextRow, 0) * * * * *NextRow = NextRow + 1 * * * * End If * * * Next Cell * * If Not Rng Is Nothing Then Rng.EntireRow.Delete End Sub This code looks in every row of Sheet 1/Column B for a date that is less than or equal to 30 days from today’s date. *When a date in Column B matches that criterion the entire row that the date is in is transferred to a new row in Sheet2. * I would like to change the search criterion and I am looking for help.. *I would like the macro to look for a date that is 30 days before today’s date first (today it would be 6/17/09). *Once that date is identified then I would like the macro to look in every row of Sheet1/Column B for every date that is less than or equal 30 days before that date; when those dates are found I would like to transfer them and their rows only to Sheet2 into a new row. *If you can help, thank you. * Jazz, It appears that you are already making that comparison (unless I've drastically missed something). *The code below lists the following: Cell = CheckDate And Cell <= TodayDate; or in other words, Cell = 6/17/09 And Cell <= 7/17/09. *As you stated, this is "30 days before today's date". I added another variable (TodayDate) and moved some of the code from the For Each loop to the If Then statement below the For Each loop. (An alternative method would be to use the Find method to create a unioned range of dates found. *See the VBE help files for "Find Method" for more details). *Also, if you want "every" row in Column B, then change your SrcRng to Set SrcRng = Columns("B"). Best, Matthew Herbert Sub SearchDate() Dim Cell As Range Dim CheckDate As Date Dim TodayDate As Date Dim DstRng As Range Dim NextRow As Long Dim Rng As Range Dim RngEnd As Range Dim SrcRng As Range Dim rngFound As Range TodayDate = Int(Now()) CheckDate = TodayDate - 30 Set SrcRng = Worksheets("Sheet1").Range("B2") Set DstRng = Worksheets("Sheet2").Range("A2") Set RngEnd = SrcRng.Parent.Cells(Rows.Count, SrcRng.Column).End(xlUp) Set SrcRng = IIf(RngEnd.Row < SrcRng.Row, SrcRng, SrcRng.Parent.Range (SrcRng, RngEnd)) Set RngEnd = DstRng.Parent.Cells(Rows.Count, DstRng.Column).End(xlUp) Set DstRng = IIf(RngEnd.Row < DstRng.Row, DstRng, RngEnd.Offset(1, 0)) For Each Cell In SrcRng * * If Cell = CheckDate And Cell <= TodayDate Then * * * * If Rng Is Nothing Then Set Rng = Cell * * * * Set Rng = Union(Rng, Cell) * * End If Next Cell If Not Rng Is Nothing Then * * Rng.EntireRow.Copy DstRng * * Rng.EntireRow.Delete End If End Sub- Hide quoted text - - Show quoted text - Jazz, Add another date variable (which I've called NewDate = CheckDate - 30) and then run your If Then statement (If Cell = NewDate And Cell <= CheckDate Then). I included all the code below which you can adjust as you please. Best, Matthew Herbert Sub SearchDate() Dim Cell As Range Dim TodayDate As Date Dim CheckDate As Date Dim NewDate As Date Dim DstRng As Range Dim NextRow As Long Dim Rng As Range Dim RngEnd As Range Dim SrcRng As Range Dim rngFound As Range TodayDate = Int(Now()) CheckDate = TodayDate - 30 NewDate = CheckDate - 30 Set SrcRng = Worksheets("Sheet1").Range("B2") Set DstRng = Worksheets("Sheet2").Range("A2") Set RngEnd = SrcRng.Parent.Cells(Rows.Count, SrcRng.Column).End(xlUp) Set SrcRng = IIf(RngEnd.Row < SrcRng.Row, SrcRng, SrcRng.Parent.Range (SrcRng, RngEnd)) Set RngEnd = DstRng.Parent.Cells(Rows.Count, DstRng.Column).End(xlUp) Set DstRng = IIf(RngEnd.Row < DstRng.Row, DstRng, RngEnd.Offset(1, 0)) For Each Cell In SrcRng If Cell = NewDate And Cell <= CheckDate Then If Rng Is Nothing Then Set Rng = Cell Set Rng = Union(Rng, Cell) End If Next Cell If Not Rng Is Nothing Then Rng.EntireRow.Copy DstRng Rng.EntireRow.Delete End If End Sub |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
SearchDate
Whoa, this is awesome. Thank you Matt. I am grateful for the help.
Regards, Jazz "Matthew Herbert" wrote: On Jul 19, 12:28 pm, Jazz wrote: Hi Matt, From the feedback I got I realized that I wasnt entirely clear. My apologies. What I am trying to do, whenever I run the macro, is get the date which is 30 days from todays date. Once I have found that date. I want to grab all the dates that are less than or equal to 30 days from the new date. For example, lets say I ran the macro today. This is what I want to have happen 1. Today is 7/19/09 2. 30 days before 7/19/09 is 6/19/09 3. Here are all the rows in Sheet1 with dates in Column B that are less than or equal to 30 days before 6/19/09; next the list gets pasted into Sheet2. Please let me know if there is still any ambiguity. Yes you are correct, if I want every row in Column B I should say SrcRng = Columns("B"). Thank again for your help. Regards, Jazz P.S. Your modifications to the macro are really good. "Matthew Herbert" wrote: On Jul 17, 3:11 pm, Jazz wrote: Sub SearchDate() Dim Cell As Range Dim CheckDate As Date Dim DstRng As Range Dim NextRow As Long Dim Rng As Range Dim RngEnd As Range Dim SrcRng As Range CheckDate = Int(Now()) - 30 Set SrcRng = Worksheets("Sheet1").Range("B2") Set DstRng = Worksheets("Sheet2").Range("A2") Set RngEnd = SrcRng.Parent.Cells(Rows.Count, SrcRng.Column)..End(xlUp) Set SrcRng = IIf(RngEnd.Row < SrcRng.Row, SrcRng, SrcRng.Parent.Range(SrcRng, RngEnd)) Set RngEnd = DstRng.Parent.Cells(Rows.Count, DstRng.Column)..End(xlUp) Set DstRng = IIf(RngEnd.Row < DstRng.Row, DstRng, RngEnd.Offset(1, 0)) For Each Cell In SrcRng If Cell = CheckDate And Cell <= Int(Now()) Then If Rng Is Nothing Then Set Rng = Cell Set Rng = Union(Rng, Cell) Cell.EntireRow.Copy DstRng.Offset(NextRow, 0) NextRow = NextRow + 1 End If Next Cell If Not Rng Is Nothing Then Rng.EntireRow.Delete End Sub This code looks in every row of Sheet 1/Column B for a date that is less than or equal to 30 days from todays date. When a date in Column B matches that criterion the entire row that the date is in is transferred to a new row in Sheet2. I would like to change the search criterion and I am looking for help.. I would like the macro to look for a date that is 30 days before todays date first (today it would be 6/17/09). Once that date is identified then I would like the macro to look in every row of Sheet1/Column B for every date that is less than or equal 30 days before that date; when those dates are found I would like to transfer them and their rows only to Sheet2 into a new row. If you can help, thank you. Jazz, It appears that you are already making that comparison (unless I've drastically missed something). The code below lists the following: Cell = CheckDate And Cell <= TodayDate; or in other words, Cell = 6/17/09 And Cell <= 7/17/09. As you stated, this is "30 days before today's date". I added another variable (TodayDate) and moved some of the code from the For Each loop to the If Then statement below the For Each loop. (An alternative method would be to use the Find method to create a unioned range of dates found. See the VBE help files for "Find Method" for more details). Also, if you want "every" row in Column B, then change your SrcRng to Set SrcRng = Columns("B"). Best, Matthew Herbert Sub SearchDate() Dim Cell As Range Dim CheckDate As Date Dim TodayDate As Date Dim DstRng As Range Dim NextRow As Long Dim Rng As Range Dim RngEnd As Range Dim SrcRng As Range Dim rngFound As Range TodayDate = Int(Now()) CheckDate = TodayDate - 30 Set SrcRng = Worksheets("Sheet1").Range("B2") Set DstRng = Worksheets("Sheet2").Range("A2") Set RngEnd = SrcRng.Parent.Cells(Rows.Count, SrcRng.Column).End(xlUp) Set SrcRng = IIf(RngEnd.Row < SrcRng.Row, SrcRng, SrcRng.Parent.Range (SrcRng, RngEnd)) Set RngEnd = DstRng.Parent.Cells(Rows.Count, DstRng.Column).End(xlUp) Set DstRng = IIf(RngEnd.Row < DstRng.Row, DstRng, RngEnd.Offset(1, 0)) For Each Cell In SrcRng If Cell = CheckDate And Cell <= TodayDate Then If Rng Is Nothing Then Set Rng = Cell Set Rng = Union(Rng, Cell) End If Next Cell If Not Rng Is Nothing Then Rng.EntireRow.Copy DstRng Rng.EntireRow.Delete End If End Sub- Hide quoted text - - Show quoted text - Jazz, Add another date variable (which I've called NewDate = CheckDate - 30) and then run your If Then statement (If Cell = NewDate And Cell <= CheckDate Then). I included all the code below which you can adjust as you please. Best, Matthew Herbert Sub SearchDate() Dim Cell As Range Dim TodayDate As Date Dim CheckDate As Date Dim NewDate As Date Dim DstRng As Range Dim NextRow As Long Dim Rng As Range Dim RngEnd As Range Dim SrcRng As Range Dim rngFound As Range TodayDate = Int(Now()) CheckDate = TodayDate - 30 NewDate = CheckDate - 30 Set SrcRng = Worksheets("Sheet1").Range("B2") Set DstRng = Worksheets("Sheet2").Range("A2") Set RngEnd = SrcRng.Parent.Cells(Rows.Count, SrcRng.Column).End(xlUp) Set SrcRng = IIf(RngEnd.Row < SrcRng.Row, SrcRng, SrcRng.Parent.Range (SrcRng, RngEnd)) Set RngEnd = DstRng.Parent.Cells(Rows.Count, DstRng.Column).End(xlUp) Set DstRng = IIf(RngEnd.Row < DstRng.Row, DstRng, RngEnd.Offset(1, 0)) For Each Cell In SrcRng If Cell = NewDate And Cell <= CheckDate Then If Rng Is Nothing Then Set Rng = Cell Set Rng = Union(Rng, Cell) End If Next Cell If Not Rng Is Nothing Then Rng.EntireRow.Copy DstRng Rng.EntireRow.Delete End If End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|