Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to Select Range based on dates in cells
Two workbooks are identical with respect to worksheets, row & columns
layouts, etc. Data for 2003 and 2004 is located in range B4:AJ305 of "Sheet 3" of WkBk "2004" and range B4:B305 contains only dates (format M/D/YYYY). "Sheet 3" of WkBk "2005" contains no data in range B4:AJ305, but is otherwise identical in terms of row & column layout. I need VBA code that will: 1) Sort the rows in range B4:AJ305 of "Sheet 3" of WkBk "2004" in ascending order based on the date values in column B (range is B4:B305), then 2) Select only those rows in "Sheet 3" of WkBk "2004" where the date value in range B4:B305 is greater than 12/31/2003 (2004 dates) and then, 3) copy values, formats, and validations of that range (the rows with 2004 data) into range B4:AJ305 of "Sheet 3" of WkSht "2005". I read posts by Tom Olgivy's where he recommends use of "Range("A2").Value = Range("A1").Value" as a way to simplify Copy and PasteSpecial routines, but do not know how to tweak that approach to set the values in a range in one WkBk equal to a range in a different WkBk. I managed to piece together the following code to almost do what I need. I suspect the code is neither elegant nor as efficient as it could be. Any suggetions/feedback will be greatly appreciated. Mike Taylor --------------------------------------------------------------------------- Sub CopyBasedOnDates() Dim wkbDest As Workbook Dim wksDest As Worksheet Dim wksSrc As Worksheet Dim strMyDate As String Dim rngDateCol As Range Dim rngCopy As Range Dim Lrow As Long Dim lNextRow As Long strMyDate = InputBox("Enter a date") 'Exit if a date was not entered If Not IsDate(strMyDate) Then Exit Sub End If 'The active sheet is the source Set wksSrc = ActiveSheet wksSrc.Activate Range("B4").Select 'Create a new workbook to store the results Set wkbDest = Workbooks.Add(1) 'Set the first worksheet to hold the results Set wksDest = wkbDest.Worksheets(1) 'Reset this variable lNextRow = 0 'Set a reference to the dates column. Adjust this as needed. With wksSrc Set rngDateCol = .Range("B4:B" & _ ..Range("B" & .Rows.Count).End(xlUp).Row) End With 'Loop through each cell (row) in the dates column For Lrow = 1 To rngDateCol.Rows.Count 'If the date in the dates column matches the date entered... If rngDateCol(Lrow).Value DateValue(strMyDate) Then '...store the range of the source worksheet. This will be 'copied over to the new (destination) worksheet With wksSrc Set rngCopy = .Range(.Cells(rngDateCol(Lrow).Row, "A"), _ ..Cells(rngDateCol(Lrow).Row, "AQ")) End With '...increment the row counter for the destination worksheet lNextRow = lNextRow + 1 '..."paste" the stored range into the destination worksheet wksDest.Cells(lNextRow, "A"). _ Resize(, rngCopy.Columns.Count).Value = rngCopy.Value End If Next wksSrc.Activate Rows("1:3").Select Selection.Copy wksDest.Activate Rows("1:1").Select Selection.Insert Shift:=xlDown Selection.PasteSpecial Paste:=8, Operation:=xlNone, SkipBlanks:=False _ , Transpose:=False wksSrc.Activate Columns("A:A").Select Application.CutCopyMode = False Selection.Copy wksDest.Activate Columns("A:A").Select 'Selection.Insert Shift:=xlToRight ActiveSheet.Paste wksSrc.Activate ActiveSheet.Range("B4:AJ4").Select 'Rows("4:4").Select Application.CutCopyMode = False Selection.Copy wksDest.Activate ActiveSheet.Range("B4:AJ305").Select 'Paste:=8 means paste column widths Selection.PasteSpecial Paste:=8, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False 'Paste:=6 means paste validation Selection.PasteSpecial Paste:=6, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Selection.Locked = False Selection.FormulaHidden = False Range("B4").Select 'Show the SaveAs dialog wkbDest.Activate Application.Dialogs(xlDialogSaveAs).Show "2005 DTR 5.0 test.xls" Set wkbDest = Nothing Set wksDest = Nothing Set wksSrc = Nothing End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to Select Range based on dates in cells
Try something like:
Option Explicit Sub TestCopyTo2005() Dim rDest As Range Dim rSource As Range With Workbooks("2004").Sheets("Sheet 3").Range("B4:AJ305") .Select .Sort Key1:=Range("B4"), _ Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom .Find(What:="*/*/04", After:=ActiveCell, LookIn:=xlValues, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False).Activate End With Set rSource = Range(ActiveCell, Range("AJ305")) Set rDest = Workbooks("2005").Sheets("Sheet 3").Range("B4") rSource.Copy rDest End Sub "Mike" wrote: Two workbooks are identical with respect to worksheets, row & columns layouts, etc. Data for 2003 and 2004 is located in range B4:AJ305 of "Sheet 3" of WkBk "2004" and range B4:B305 contains only dates (format M/D/YYYY). "Sheet 3" of WkBk "2005" contains no data in range B4:AJ305, but is otherwise identical in terms of row & column layout. I need VBA code that will: 1) Sort the rows in range B4:AJ305 of "Sheet 3" of WkBk "2004" in ascending order based on the date values in column B (range is B4:B305), then 2) Select only those rows in "Sheet 3" of WkBk "2004" where the date value in range B4:B305 is greater than 12/31/2003 (2004 dates) and then, 3) copy values, formats, and validations of that range (the rows with 2004 data) into range B4:AJ305 of "Sheet 3" of WkSht "2005". I read posts by Tom Olgivy's where he recommends use of "Range("A2").Value = Range("A1").Value" as a way to simplify Copy and PasteSpecial routines, but do not know how to tweak that approach to set the values in a range in one WkBk equal to a range in a different WkBk. I managed to piece together the following code to almost do what I need. I suspect the code is neither elegant nor as efficient as it could be. Any suggetions/feedback will be greatly appreciated. Mike Taylor --------------------------------------------------------------------------- Sub CopyBasedOnDates() Dim wkbDest As Workbook Dim wksDest As Worksheet Dim wksSrc As Worksheet Dim strMyDate As String Dim rngDateCol As Range Dim rngCopy As Range Dim Lrow As Long Dim lNextRow As Long strMyDate = InputBox("Enter a date") 'Exit if a date was not entered If Not IsDate(strMyDate) Then Exit Sub End If 'The active sheet is the source Set wksSrc = ActiveSheet wksSrc.Activate Range("B4").Select 'Create a new workbook to store the results Set wkbDest = Workbooks.Add(1) 'Set the first worksheet to hold the results Set wksDest = wkbDest.Worksheets(1) 'Reset this variable lNextRow = 0 'Set a reference to the dates column. Adjust this as needed. With wksSrc Set rngDateCol = .Range("B4:B" & _ ..Range("B" & .Rows.Count).End(xlUp).Row) End With 'Loop through each cell (row) in the dates column For Lrow = 1 To rngDateCol.Rows.Count 'If the date in the dates column matches the date entered... If rngDateCol(Lrow).Value DateValue(strMyDate) Then '...store the range of the source worksheet. This will be 'copied over to the new (destination) worksheet With wksSrc Set rngCopy = .Range(.Cells(rngDateCol(Lrow).Row, "A"), _ ..Cells(rngDateCol(Lrow).Row, "AQ")) End With '...increment the row counter for the destination worksheet lNextRow = lNextRow + 1 '..."paste" the stored range into the destination worksheet wksDest.Cells(lNextRow, "A"). _ Resize(, rngCopy.Columns.Count).Value = rngCopy.Value End If Next wksSrc.Activate Rows("1:3").Select Selection.Copy wksDest.Activate Rows("1:1").Select Selection.Insert Shift:=xlDown Selection.PasteSpecial Paste:=8, Operation:=xlNone, SkipBlanks:=False _ , Transpose:=False wksSrc.Activate Columns("A:A").Select Application.CutCopyMode = False Selection.Copy wksDest.Activate Columns("A:A").Select 'Selection.Insert Shift:=xlToRight ActiveSheet.Paste wksSrc.Activate ActiveSheet.Range("B4:AJ4").Select 'Rows("4:4").Select Application.CutCopyMode = False Selection.Copy wksDest.Activate ActiveSheet.Range("B4:AJ305").Select 'Paste:=8 means paste column widths Selection.PasteSpecial Paste:=8, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False 'Paste:=6 means paste validation Selection.PasteSpecial Paste:=6, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Selection.Locked = False Selection.FormulaHidden = False Range("B4").Select 'Show the SaveAs dialog wkbDest.Activate Application.Dialogs(xlDialogSaveAs).Show "2005 DTR 5.0 test.xls" Set wkbDest = Nothing Set wksDest = Nothing Set wksSrc = Nothing End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Sum select cells based on date range | Excel Worksheet Functions | |||
how can I select a range of cells based on a value of a cell? | Excel Discussion (Misc queries) | |||
How do I select from within a range of dates? | Excel Discussion (Misc queries) | |||
Counting a range of cells based on 2 dates? | Excel Programming | |||
Select range with specified dates | Excel Programming |