Excel 2007 : Fill gap between dates

[Amalaswinta]

Hi all,

I was wondering if the following is possible:

column A contains dates (every day of the year) and upon sheet activation excel automatically (vba code) goes to the current date.
column B contains numeric values (weight)

every day one should enter the current weight.
that's the ideal situation. But what if you forget a day.

what I'd like is that excel sees that yesterday and/or days before that are empty and then automatically fills the gap between today and the last previous entry with that last entry.
further more, in column C it should say "automated entry" for those cells.

Does that make sense?

[Marcol]

Try this in the workbook module

Option Explicit

Private Sub Workbook_Open()
    Dim LastRow As Long, RowNo As Long

    With Sheets("Sheet1")
        LastRow = .Range("A" & Rows.Count).End(xlUp).Row
        If .Range("A" & LastRow) < Date - 1 Then
            If .Range("A" & LastRow).Offset(0, 1) = "" Then
                .Range("A" & LastRow).Offset(0, 1) = .Range("A" & LastRow).Offset(-1, 1)
                .Range("A" & LastRow).Offset(0, 2) = "Automated Entry"
            End If
            For RowNo = LastRow To LastRow + Date - .Range("A" & LastRow) - 1
                If .Range("A" & RowNo + 1) = "" Then
                    .Range("A" & RowNo + 1) = .Range("A" & RowNo) + 1
                    If .Range("A" & RowNo + 1) <> Date Then
                        .Range("A" & RowNo + 1).Offset(0, 1) = .Range("A" & RowNo + 1).Offset(-1, 1)
                        .Range("A" & RowNo + 1).Offset(0, 2) = "Automated Entry"
                    End If
                End If
            Next

        End If
    End With
End Sub

When you open this demo with macros enabled it will automatically add the missing data.
To test
Delete the last few rows (A:C) save the workbook, close, and reopen.
then
Delete the last few rows (A:C) plus what becomes the last row Column B, save the workbook, close, and reopen

Note: This will not fill missing entries in old sheets with missing data, it will only work from the last entered date forward.

[Amalaswinta]

wow! you're a star

one more thing though: I can sort of see how this works but am not quite sure how to fit this into my own sheet since the dates are already there.
in your sheet the date gets entered upon opening, how can I get passed that so it only looks at the dates already present in column A?

[Marcol]

This will work from the last date entered in your sheet, automatically entering todays' date in the last row, leaving you to add the current weight, if you forget to add it that day then the code will repeat the sequence when it is next opened.
That seems to me to do what you are needing.

Are you asking for code to check for and insert any missing data to an existing sheet, so that you have an unbroken sequence of dates and weights?

[Amalaswinta]

ah, I understand the confusion now

I don't need the code to enter the dates, I've done that already (column A contains a whole year in dates)

Upon opening the workbook the code only needs to check whether a weight is present on all dates except for the current. Something like this:

..............A..........B........C
146.......5/25.......70
147.......5/26.......
148.......5/27.......
149.......5/28.......
150.......5/29.......
151.......5/30.......
etc

in this case (A149 being the current date) the only thing that should be happening is cell B146 being copied down to cell B147 and B148 and "Automated entry" being added to C147 and C148

hope that clears it up?

btw: thanks so much for helping me!

[Marcol]

Okay, try this in a standard module.

Option Explicit

Sub CheckDatesAndFillMissingWeights()
    Dim RowNo As Long

    On Error GoTo ResetApplication
    Application.ScreenUpdating = False

    With Sheets("Sheet1")
        RowNo = 2
        Do
            If .Range("A" & RowNo) = .Range("A" & RowNo + 1) - 1 Then
                If .Range("A" & RowNo) < Date And .Range("B" & RowNo) = "" Then
                    .Range("B" & RowNo) = .Range("B" & RowNo - 1)
                End If
            Else
                If .Range("A" & RowNo + 1) <> "" Then
                    .Range("A" & RowNo + 1).EntireRow.Insert
                    .Range("A" & RowNo + 1) = .Range("A" & RowNo) + 1
                    If .Range("A" & RowNo) < Date Then
                        .Range("B" & RowNo + 1) = .Range("B" & RowNo)
                    End If
                    RowNo = RowNo - 1
                End If
            End If
            RowNo = RowNo + 1
        Loop Until .Range("A" & RowNo) = ""
    End With
    
ResetApplication:
    Err.Clear
    On Error GoTo 0
    Application.ScreenUpdating = True
End Sub

Then in the workbook module

Option Explicit

Private Sub Workbook_Open()
    CheckDatesAndFillMissingWeights
End Sub

This will check for missing data every time you open the workbook, column "B" will be updated up until yesterdays' date.

I have l put in ann extra sheet that shows how sheet1 was when I posted it and before you opened it with macros enabled.

The conditional formatting highlights todays' date, (yellow), to let you know where to put your daily sampling.

Hope this helps

[Amalaswinta]

thanks!!!
you're a life saver