Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Lousy routine to get the first available day of the month
I have a worksheet with dates and data. The date column only includes
business days from different countries. I need to retrieve the first available business days for every month and every year. Here is my lousy yet working code. I parse the A column, where the date reside) into 3 (month, day and year) and sort the worksheet by day (column b). Then I autofilter each month, autofilter each year and finally copy the results. I loop for each month and each year. It works but looks there must be a better and faster way. BTW, I’m not a programmer, which explains the complicated code: Application.ScreenUpdating = False Columns("B:C").Insert Shift:=xlToRight Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=xlNone, OtherChar:="/" Columns("A:C").NumberFormat = "General" Range("A1") = "month" Range("B1") = "day" Range("C1") = "year" c = 1 'month yhigh = Application.Max(Columns("C:C")) + 1 'the highest year Range(("A1"), Range("A1").SpecialCells(xlLastCell)).Select With Selection .Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlYes Do Until c = 13 '12 = December ylow = Application.Min(Columns("C:C")) 'reset the lowest year .AutoFilter Field:=1, Criteria1:=c Do Until ylow = yhigh .AutoFilter Field:=3, Criteria1:=ylow Selection.Copy Sheets("data1").Select ActiveCell.PasteSpecial xlPasteAll ActiveCell.EntireRow.Delete ActiveCell.Offset(1, 0).Activate Range(ActiveCell, ActiveCell.SpecialCells(xlLastCell)).Delete Sheets("data").Select ylow = ylow + 1 'go through each year for specific month (c) Loop c = c + 1 'goto next month Loop End With Sheets("data1").Select Range(("B1"), Range("B1").End(xlDown)) = 1 'each first day of the month must equat 1 Range(("A1"), Range("A1").SpecialCells(xlLastCell)).Sort Key1:=Range("C1"), Order1:=xlAscending, Key2:=Range("A1"), Order2:=xlAscending, Header:=xlYes |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Lousy routine to get the first available day of the month
So...
You have a bunch of dates in column A (A2:A999, say). And there could be duplicates for each date. You want to keep the first date in each month and copy them somewhere else? How about this technique: 1. Sort the data by the date column (ascending order). 2. Instead of parsing the date into month, day, year columns, you insert a couple of columns to use as indicators to see if that record should be kept. 3. Then filter these results. 4. Copy|paste the visible rows to a new worksheet. 5. Delete the helper columns (from both sheets). ======== I'm gonna assume that the data has a header row with headers in each column. And it also has a date in each row (A2:A999) so I can use these to determine what to sort and filter. In code: Option Explicit Sub testme() Dim wks As Worksheet Dim RptWks As Worksheet Dim RngToSort As Range Dim LastRow As Long Dim LastCol As Long Set wks = Worksheets("Sheet1") 'activesheet? Set RptWks = Worksheets("Data") 'existing sheet. With wks 'remove any existing filter .AutoFilterMode = False 'insert two new temporary columns (B:C) .Range("B1").Resize(1, 2).EntireColumn.Insert 'determine what to sort LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column Set RngToSort = .Range("A1", .Cells(LastRow, LastCol)) With RngToSort .Sort key1:=.Columns(1), order1:=xlAscending, _ header:=xlYes, MatchCase:=False End With With .Range("B2:B" & LastRow) .NumberFormat = "General" 'make sure it's not Text .Formula = "=IF(TEXT(A2,""yyyymm"")<TEXT(A1,""yyyymm""), " _ & """keepit"","""")" End With With .Range("C2:C" & LastRow) .NumberFormat = "General" .Formula = "=VLOOKUP(A2,A:B,2,FALSE)" End With Application.Calculate 'just in case! 'convert to values (quicker filtering times With .Range("B:C") .Cells.Copy .Cells.PasteSpecial Paste:=xlPasteValues End With RngToSort.AutoFilter field:=3, Criteria1:="Keepit" With .AutoFilter.Range 'check to see if only the headers are visible If .Columns(1).Cells.SpecialCells(xlCellTypeVisible) _ .Cells.Count = 1 Then MsgBox "No details records found!" Else 'remove the header and come down one row to the data .Resize(.Rows.Count - 1).Offset(1, 0) _ .Cells.SpecialCells(xlCellTypeVisible).Copy _ Destination:=RptWks.Range("a2") End If End With 'remove the autofilter .AutoFilterMode = False 'remove the helper columns .Range("B1").Resize(1, 2).EntireColumn.Delete 'from the new sheet, too RptWks.Range("B1").Resize(1, 2).EntireColumn.Delete End With End Sub ========= The two formulas (in columns B and C) look like: =IF(TEXT(A2,"yyyymm")<TEXT(A1,"yyyymm"),"keepit", "") and =VLOOKUP(A2,A:B,2,FALSE) After the data is sorted by date (ascending), then column B will show a "keepit" indicator if it's the first row of the month. Then column C will return that same indicator for all the same dates (first date in the month). On 07/08/2010 17:31, Frank wrote: I have a worksheet with dates and data. The date column only includes business days from different countries. I need to retrieve the first available business days for every month and every year. Here is my lousy yet working code. I parse the A column, where the date reside) into 3 (month, day and year) and sort the worksheet by day (column b). Then I autofilter each month, autofilter each year and finally copy the results. I loop for each month and each year. It works but looks there must be a better and faster way. BTW, I’m not a programmer, which explains the complicated code: Application.ScreenUpdating = False Columns("B:C").Insert Shift:=xlToRight Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=xlNone, OtherChar:="/" Columns("A:C").NumberFormat = "General" Range("A1") = "month" Range("B1") = "day" Range("C1") = "year" c = 1 'month yhigh = Application.Max(Columns("C:C")) + 1 'the highest year Range(("A1"), Range("A1").SpecialCells(xlLastCell)).Select With Selection .Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlYes Do Until c = 13 '12 = December ylow = Application.Min(Columns("C:C")) 'reset the lowest year .AutoFilter Field:=1, Criteria1:=c Do Until ylow = yhigh .AutoFilter Field:=3, Criteria1:=ylow Selection.Copy Sheets("data1").Select ActiveCell.PasteSpecial xlPasteAll ActiveCell.EntireRow.Delete ActiveCell.Offset(1, 0).Activate Range(ActiveCell, ActiveCell.SpecialCells(xlLastCell)).Delete Sheets("data").Select ylow = ylow + 1 'go through each year for specific month (c) Loop c = c + 1 'goto next month Loop End With Sheets("data1").Select Range(("B1"), Range("B1").End(xlDown)) = 1 'each first day of the month must equat 1 Range(("A1"), Range("A1").SpecialCells(xlLastCell)).Sort Key1:=Range("C1"), Order1:=xlAscending, Key2:=Range("A1"), Order2:=xlAscending, Header:=xlYes -- Dave Peterson |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Lousy routine to get the first available day of the month
Hi Dave:
Thanks for your help. Using .Formula = "=IF(TEXT(A2,""yyyymm"")<TEXT(A1,""yyyymm""), " & """keepit"","""")" was brilliant! Since I don’t need to keep the data (which is sorted by ascending date and has no filter), I incorporated your solution as follows: Dim RngToSort As Range Dim LastRow As Long Dim LastCol As Long 'insert two new temporary columns (B:C) Range("B1").Resize(1, 1).EntireColumn.Insert 'determine what to sort LastRow = Cells(Rows.Count, "A").End(xlUp).Row LastCol = Cells(1, Columns.Count).End(xlToLeft).Column Set RngToSort = Range("A1", Cells(LastRow, LastCol)) With Range("B2:B" & LastRow) .NumberFormat = "General" 'make sure it's not Text .Formula = "=IF(TEXT(A2,""yyyymm"")<TEXT(A1,""yyyymm""),A2," """)" .Cells.Copy .Cells.PasteSpecial Paste:=xlPasteValues .Cells.NumberFormat = "m/d/yyyy" .Cells.Value = .Cells.Value End With RngToSort.Sort key1:=Columns(2), order1:=xlAscending, header:=xlYes Range(Range("B2").End(xlDown).Offset(1, -1), Range("B2").End(xlDown).Offset(1, -1).SpecialCells(xlLastCell)).Delete Columns("A:A").Delete Shift = xlToLeft But the rest of your code is something I probably will use in other application. I need to learn about "resize". I have the VBA bible book, I just need to get familiar with that function. Regards, |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Check Date, Include dates from rest of month and all of next month | Excel Programming | |||
excel to make the days cary over month to month automaticly | New Users to Excel | |||
Excel 2003 month to month data change grid | Excel Discussion (Misc queries) | |||
copy worksheet from previous month and rename to current month | Excel Programming | |||
transfer cell $ amount to other sheet month-to-month without overc | Excel Discussion (Misc queries) |