Solved

dates are missing

Posted on 2011-09-14
3
247 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 41

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 41

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

ScreenConnect 6.0 Free Trial

Check out the updates in one game-changing release, ScreenConnect 6.0, based on partner feedback. New features include a redesigned UI that improves session organization and overall user experience. See the enhancements for yourself!

Question has a verified solution.

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

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
Introduction While answering a recent question (http:/Q_27311462.html), I created an alternative function to the Excel Concatenate() function that you might find useful.  I tested several solutions and share the results in this article as well as t…
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

770 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