Solved

dates are missing

Posted on 2011-09-14
3
249 Views
Last Modified: 2012-05-12
Hi. Anyone know a good strategy for filling in missing dates in a column of dates? I have a column of dates (and an adjacent column with 1 in each corresponding row). I want to insert all the missing dates and add 0 in the adjacent cell (the same column where the ones are). Anyone know a good way to do this?

Thanks. target123.csv
0
Comment
Question by:onyourmark
  • 2
3 Comments
 
LVL 33

Accepted Solution

by:
Norie earned 225 total points
ID: 36540344
Probably not quite what you want but this will create a list with all the dates and put a 1 next to the those in the original list and a 0 next to the new dates.
Option Explicit

Sub DateList()
Dim dtStart As Date
Dim dtEnd As Date
Dim NoDays As Long

    dtStart = Range("A2")
    dtEnd = Range("A" & Rows.Count).End(xlUp)

    NoDays = dtEnd - dtStart + 1

    With Range("F2")
        .Offset(-1) = "Date"
        .Value = dtStart
        .DataSeries Rowcol:=xlColumns, Type:=xlChronological, Date:= _
                    xlDay, Step:=1, Stop:=Range("A" & Rows.Count).End(xlUp), Trend:=False
        With .Offset(, 1).Resize(NoDays)
            .Formula = "=COUNTIF(A:A, F2)"
            .Value = .Value
        End With
    End With

End Sub

Open in new window

0
 
LVL 42

Assisted Solution

by:dlmille
dlmille earned 275 total points
ID: 36540369
Just place the data in the activesheet, and run the macro insertMissingDates().  There's a button on the sheet.

Here's the code:
 
Option Explicit

Sub insertMissingDates()
Dim sht As Worksheet
Dim myCell As Range
Dim firstDate As Date, lastDate As Date
Dim i As Date
Dim outCursor As Range
Dim fRange As Range

    Set sht = ActiveSheet
    firstDate = sht.Range("A2").Value
    lastDate = sht.Range("A" & sht.Rows.Count).End(xlUp).Value
    
    For i = firstDate To lastDate
        Set fRange = sht.Range("A:A").Find(what:=i, LookIn:=xlFormulas, lookat:=xlWhole)
        If Not fRange Is Nothing Then
            Set outCursor = fRange
        Else
            outCursor.Offset(1, 0).EntireRow.Insert
            Set outCursor = outCursor.Offset(1, 0)
            outCursor.Value = i
            outCursor.Offset(0, 1).Value = 0
        End If
    Next i
End Sub

Open in new window


Enjoy!

Dave
target123-r1.xlsm
0
 
LVL 42

Assisted Solution

by:dlmille
dlmille earned 275 total points
ID: 36540401
Just a "nice to do" add.  This version prompts you for the CSV file and makes the change in that file.  Do with it what you want from there :)

Here's the revised code:

 
Option Explicit
Sub insertMissingDates()
Dim sht As Worksheet
Dim myCell As Range
Dim firstDate As Date, lastDate As Date
Dim i As Date
Dim outCursor As Range
Dim fRange As Range
Dim myWkb As Workbook
Dim fName As Variant

    Set sht = ActiveSheet
    fName = selectFile("", ActiveWorkbook.Path, "Select CSV file for date processing")
    If fName = "" Then Exit Sub 'must have canceled
    
    Set myWkb = Workbooks.Open(Filename:=fName)
    If myWkb Is Nothing Then
        MsgBox "Can't open the file: " & fName, vbCritical, "Aborting."
        Exit Sub
    End If
    
    Set sht = myWkb.ActiveSheet
    
    firstDate = sht.Range("A2").Value
    lastDate = sht.Range("A" & sht.Rows.Count).End(xlUp).Value
    
    For i = firstDate To lastDate
        Set fRange = sht.Range("A:A").Find(what:=i, LookIn:=xlFormulas, lookat:=xlWhole)
        If Not fRange Is Nothing Then
            Set outCursor = fRange
        Else
            outCursor.Offset(1, 0).EntireRow.Insert
            Set outCursor = outCursor.Offset(1, 0)
            outCursor.Value = i
            outCursor.Offset(0, 1).Value = 0
        End If
    Next i
    MsgBox "Processing Complete"
End Sub
Function selectFile(initFname As String, initPath As String, msg As String) As Variant
Dim wbk As Workbook
Dim fDialog As Office.FileDialog
Dim myPath As String

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    
    On Error GoTo errhandler

    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
         
    If initPath = "" Then
        myPath = ThisWorkbook.Path
    Else
        myPath = initPath
    End If
    
    If Right(myPath, 1) <> "\" Then myPath = myPath & "\"
    
    With fDialog
        .AllowMultiSelect = False
        .Title = "Select File Location for Monthly Reimbursement Processing: " & msg
        .InitialView = msoFileDialogViewDetails
        .Filters.Clear
        .Filters.Add "TEXT Files", "*.CSV"
        .InitialFileName = initPath & initFname
        If .Show = True Then selectFile = .SelectedItems(1)
        .Filters.Clear
    End With
    
    Exit Function
    
errhandler:
    MsgBox "Error Selecting File/Folder #: " & Err.Number & "-> " & Err.Description, vbCritical, "Aborting"
    selectFile = False
End Function

Open in new window


See attached - open it, ensure macros are enabled, and click the macro button.

Enjoy!

Dave
target123-r2.xlsm
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Introduction This Article briefly covers methods of calculating the NPV and IRR variants in Excel as well as the limitations in calculating and interpreting IRR results. Paraphrasing Richard Shockley, author of my favourite finance reference tex…
Convert between Excel file formats (.XLS, .XLSX, .XLSM) with/without macro option David Miller (dlmille) Intro Over this past Fall, I've had the opportunity to see several similar requests and have developed a couple related solutions associate…
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

679 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question