data missing in a seris of dates.... anybody can help?

AmandaSS · Mar 24, 2014

Hi guys, I need a help with this time series and list of figure.

I have a column of dates and hours. To each of them corresponds a figure.

column A	column B
01/01/2011 00:00	40
01/01/2011 01:00	-98
01/01/2011 06:00	55
01/01/2011 18:00	45

Dates and hours are organized from the oldest to the most recent, but sometimes hours / dates are missing. I need to fill column B with zeros for those hours where the figure is missing.

column A	column B
01/01/2011 00:00	40
01/01/2011 01:00	-98
01/01/2011 02:00	0
01/01/2011 03:00	0
01/01/2011 04:00	0
01/01/2011 05:00	0
01/01/2011 06:00	55
.....	0
....

thanks a lot!
Best
Amanda

pbornemeier · Mar 26, 2014

Try this. Please let me know how it works for you.

Code:

Sub InsertHourRows()

    Dim lLastDataRow As Long
    Const sngHourValue As Single = 1 / 24
    Dim lX As Long
    Dim lActiveRow As Long
    
    lLastDataRow = Cells(Rows.Count, 1).End(xlUp).Row
    lActiveRow = lLastDataRow
    Do While lActiveRow > 1   'change 1 to 2 if you have headers
        If (Cells(lActiveRow, 1) - sngHourValue) - Cells(lActiveRow - 1, 1) > 0.01 Then
            Cells(lActiveRow, 1).EntireRow.Insert
            Cells(lActiveRow, 1).Value = Cells(lActiveRow + 1, 1) - sngHourValue
            Cells(lActiveRow, 2).Value = 0
            lActiveRow = lActiveRow + 1
        End If
        lActiveRow = lActiveRow - 1
    Loop
End Sub

AmandaSS · Mar 30, 2014

Hi, thanks a lot for the code.
I tryed it but it didnt work.
It could be that I forget to do something.
What I do is the followng:
open the excel file
open VBA
select the sheet where the data are
paste the code you prepared
run it

If I see it right, I dont have to adapt the code.
Do you think I miss to do something?
Thanks again.
Amanda

pbornemeier said:

Try this. Please let me know how it works for you.

Code:

Sub InsertHourRows()

    Dim lLastDataRow As Long
    Const sngHourValue As Single = 1 / 24
    Dim lX As Long
    Dim lActiveRow As Long
    
    lLastDataRow = Cells(Rows.Count, 1).End(xlUp).Row
    lActiveRow = lLastDataRow
    Do While lActiveRow > 1   'change 1 to 2 if you have headers
        If (Cells(lActiveRow, 1) - sngHourValue) - Cells(lActiveRow - 1, 1) > 0.01 Then
            Cells(lActiveRow, 1).EntireRow.Insert
            Cells(lActiveRow, 1).Value = Cells(lActiveRow + 1, 1) - sngHourValue
            Cells(lActiveRow, 2).Value = 0
            lActiveRow = lActiveRow + 1
        End If
        lActiveRow = lActiveRow - 1
    Loop
End Sub

hiker95 · Mar 30, 2014

pbornemeier,

Nicely done - one for my archives. Thanks.

I hope you do not mind what follows.

AmandaSS,

What I do is the followng:
open the excel file
open VBA
select the sheet where the data are
paste the code you prepared
run it

What you did above is not correct.

Sample raw data:

Excel 2007

A

B

1

1/1/2011 0:00

40

2

1/1/2011 1:00

-98

3

1/1/2011 6:00

55

4

1/1/2011 18:00

45

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

Sheet1

After the macro:

Excel 2007

A

B

1

1/1/2011 0:00

40

2

1/1/2011 1:00

-98

3

1/1/2011 2:00

0

4

1/1/2011 3:00

0

5

1/1/2011 4:00

0

6

1/1/2011 5:00

0

7

1/1/2011 6:00

55

8

1/1/2011 7:00

0

9

1/1/2011 8:00

0

10

1/1/2011 9:00

0

11

1/1/2011 10:00

0

12

1/1/2011 11:00

0

13

1/1/2011 12:00

0

14

1/1/2011 13:00

0

15

1/1/2011 14:00

0

16

1/1/2011 15:00

0

17

1/1/2011 16:00

0

18

1/1/2011 17:00

0

19

1/1/2011 18:00

45

20

Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Code:

Sub InsertHourRows()
' pbornemeier, 03/30/2014, ME766334
Dim lLastDataRow As Long
Const sngHourValue As Single = 1 / 24
Dim lX As Long
Dim lActiveRow As Long
Application.ScreenUpdating = False
lLastDataRow = Cells(Rows.Count, 1).End(xlUp).Row
lActiveRow = lLastDataRow
Do While lActiveRow > 1   'change 1 to 2 if you have headers
  If (Cells(lActiveRow, 1) - sngHourValue) - Cells(lActiveRow - 1, 1) > 0.01 Then
    Cells(lActiveRow, 1).EntireRow.Insert
    Cells(lActiveRow, 1).Value = Cells(lActiveRow + 1, 1) - sngHourValue
    Cells(lActiveRow, 2).Value = 0
    lActiveRow = lActiveRow + 1
  End If
  lActiveRow = lActiveRow - 1
Loop
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the InsertHourRows macro.

AmandaSS · Mar 31, 2014

hi guys, thanks a lot for your support.
I tryed again the run but I still have some problem.
for example, I notices that in april some dates are missng.

20/04/2013 16:00	-42

21/04/2013 01:00	0

what I get is:

20/04/2013 16:00	-42
20/04/2013 00:00	0
21/04/2013 01:00	0

here there are two problems:
the system adds 20/04/2013 00:00 instead of 21/04/2013 00:00
and then of course all dates for 20 april are still missing.

The "0" added to the missing date is right.
Thanks again for the support

mirabeau · Mar 31, 2014

hi Amanda,

does this one work for you?

Code:

Sub insertdates()

Dim c, rs As Long, i As Long, j As Long
Dim y As Long, u As Long

rs = Cells(Rows.Count, 1).End(xlUp).Row
c = Cells(1).Resize(rs)

For i = 2 To rs - 1
    If c(i + 1, 1) - c(i, 1) > 1 / 24 Then
       y = Round((c(i + 1, 1) - c(i, 1)) * 24, 0)
        For j = 1 To y - 1
            u = u + 1
            Cells(rs + u, 1) = c(i, 1) + j / 24
        Next j
    End If
Next i
Cells(rs + 1, 2).Resize(u) = 0

With Cells(2, 1).Resize(u + rs - 1)
    .Resize(1).Copy
    .PasteSpecial Paste:=xlPasteFormats
    .Resize(, 2).Sort Cells(2, 1), Header:=xlNo
End With

Cells(1).Select
End Sub

AmandaSS · Mar 31, 2014

Hi mirabeau,

I tryed but I now get more rows than expected, 8779 rows, while I should have 8760.
I have a data set of hourly data for 2013, so in total i shuold get 8760 rows (which is the number of hour in a year).
I should find the error now..
Is there a way to get the missing dates in a red colour, so to identify them after the run?

mirabeau · Mar 31, 2014

AmandaSS said:
Hi mirabeau,

I tryed but I now get more rows than expected, 8779 rows, while I should have 8760.
I have a data set of hourly data for 2013, so in total i shuold get 8760 rows (which is the number of hour in a year).
I should find the error now..
Is there a way to get the missing dates in a red colour, so to identify them after the run?

Amanda,

The code worked for me on the data that you posted. I had nothing else to go on, so hard to speculate on the error.

I don't think that code was likely to error. Are you sure it's not somehow your data setup causing a possible problem?

To colour missing dates in red, add the red line as indicated.

Rich (BB code):

Sub insertdates()

Dim c, rs As Long, i As Long, j As Long
Dim y As Long, u As Long


rs = Cells(Rows.Count, 1).End(xlUp).Row
c = Cells(1).Resize(rs)


For i = 2 To rs - 1
    If c(i + 1, 1) - c(i, 1) > 1 / 24 Then
       y = Round((c(i + 1, 1) - c(i, 1)) * 24, 0)
        For j = 1 To y - 1
            u = u + 1
            Cells(rs + u, 1) = c(i, 1) + j / 24
        Next j
    End If
Next i
Cells(rs + 1, 2).Resize(u) = 0
With Cells(2, 1).Resize(u + rs - 1)
    .Resize(1).Copy
    .PasteSpecial Paste:=xlPasteFormats
    .Offset(rs).Resize(u - 1).Interior.Color = vbRed
    .Resize(, 2).Sort Cells(2, 1), Header:=xlNo
End With


Cells(1).Select
End Sub

AmandaSS · Apr 1, 2014

Hi mirabeau,

it worked quite well in the end. It could be that my data contain some errors. They are the result of a further elaboration on row data I get from European transmission grid operators about power generation from different technologies. So the data set is quite big and there might be errors.
I thank you so much, as well as pbornemeier and hiker95 for your support! I am so happy with this forum, you are cool

mirabeau · Apr 1, 2014

AmandaSS said:
Hi mirabeau,

it worked quite well in the end. It could be that my data contain some errors. They are the result of a further elaboration on row data I get from European transmission grid operators about power generation from different technologies. So the data set is quite big and there might be errors.
I thank you so much, as well as pbornemeier and hiker95 for your support! I am so happy with this forum, you are cool

A possible explanation is that your actual data are not in chronological order. The code requires that they be so in order to work properly.

Here's a modified version that you may find works better

Code:

Sub insertdates2()

Dim c, rs As Long, i As Long, j As Long
Dim y As Long, u As Long

rs = Cells(Rows.Count, 1).End(xlUp).Row
Cells(1).Resize(rs, 2).Sort Cells(1), Header:=xlYes
c = Cells(1).Resize(rs)

For i = 2 To rs - 1
    If c(i + 1, 1) - c(i, 1) > 1 / 24 Then
       y = Round((c(i + 1, 1) - c(i, 1)) * 24, 0)
        For j = 1 To y - 1
            u = u + 1
            Cells(rs + u, 1) = c(i, 1) + j / 24
        Next j
    End If
Next i

Cells(rs + 1, 2).Resize(u) = 0
With Cells(2, 1).Resize(u + rs - 1)
    .Resize(1).Copy
    .PasteSpecial Paste:=xlPasteFormats
    .Offset(rs - 1).Resize(u).Interior.Color = vbRed
    .Resize(, 2).Sort Cells(2, 1), Header:=xlNo
End With

Cells(1).Select
End Sub

data missing in a seris of dates.... anybody can help?

AmandaSS

Board Regular

Excel Facts

pbornemeier

Well-known Member

AmandaSS

Board Regular

hiker95

Well-known Member

AmandaSS

Board Regular

mirabeau

Banned user

AmandaSS

Board Regular

mirabeau

Banned user

AmandaSS

Board Regular

mirabeau

Banned user

Similar threads

Forum statistics

Share this page

data missing in a seris of dates.... anybody can help?

Board Regular

Excel Facts

Well-known Member

Board Regular

Well-known Member

Board Regular

Banned user

Board Regular

Banned user

Board Regular

Banned user

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock