Solved

dates are missing

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

Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

Join & Write a Comment

Drop Down List with Unique/Distinct Values (enhancing the Combo-Box with a few steps and a little code) David miller (dlmille) Intro Have you ever created a data validation list from a database field or spreadsheet column (e.g., Zip Codes or Co…
This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.

762 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

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now