Transforming data from monthly to daily

Question

Scenario: I have a code that reads data from other files and import into different sheets. Some of these files have data in monthly format, whereas others have it in daily format

Data example daily (yyyy-mm-dd):

              item1    item2    item3
2010/01/01    1         1         1
2010/01/02    1         1         1
2010/01/03    1         1         1
2010/01/04    1         1         1
2010/01/05    1         1         1

Data example monthly(yyyy-mm-dd), here, the date is usually the last working day of the month:

              item1    item2    item3
2010/01/31    5          3        1
2010/02/28    4          10       5
2010/03/31    7          9        2
2010/04/30    8          4        8
2010/05/31    2          7        7

Objective: I am trying to transform all the monthly data into daily, by keeping the end of month value the same for all days of the month. Ex: if my 2010/02/28 value is 10, all the days of February should have a value equal to 10 for that item.

What I already tried: I tried doing a backwards loop and adding columns, but that did not work. Now I am trying to create two arrays (one daily and one monthly), and compare: loop through monthly rows, and then daily rows, if months and years are the same, then make the value of that daily row equal to the monthly (ex: all the daily values of February will be equal to the monthly value of January, except for the last day of February, which will be the monthly value for February). Something like:

If my item 1 monthly value for January was 5, for February it was 10, and for march it was 3, then my daily data would be (assuming my data starts in January):

01/01 until 30/01 = 5, 31/01 until 27/02 = 10, 28/02 until 30/03 = 3, and so on.

Question: As I am trying to do this, I am not able to properly organize the loops, so the xx loop (for columns) ends up getting the data from the wrong row. Any idea how to solve this, or how to make this procedure in a more efficient manner?

Code:

Private Sub CommandButton2_Click()

Dim monthlydatesarray As Variant, monthlydataarray As Variant, dailydatesarray As Variant, dailydataarray As Variant
Dim xx As Long, monthlydaterow As Long, dailydaterow As Long, lastRowD As Long, lastRowM As Long
Dim wbpath As String
Dim wb As Workbook
Dim ws As Worksheet

wbpath = ThisWorkbook.Path
Set wb = ThisWorkbook

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

lastRowD = Sheets("Bid").Cells.SpecialCells(xlCellTypeLastCell).Row
lastRowM = Sheets("AMT").Cells.SpecialCells(xlCellTypeLastCell).Row

For Each ws In wb.Worksheets
    If ws.Name = "A" Then
        'sets proper columns for dates and data, both monthly and daily
        dailydatesarray = wb.Sheets("B").Range("A2:A" & lastRowD)
        dailydataarray = wb.Sheets("B").UsedRange
        monthlydatesarray = wb.Sheets("A").Range("A2:A" & lastRowM)
        monthlydataarray = wb.Sheets("A").UsedRange

        'if date matches month and year, use the data values
        For monthlydaterow = 1 To UBound(monthlydatesarray)
            For dailydaterow = 1 To UBound(dailydatesarray)
                If Month(monthlydatesarray(monthlydaterow, 1)) = Month(dailydatesarray(dailydaterow, 1)) And Year(monthlydatesarray(monthlydaterow, 1)) = Year(dailydatesarray(dailydaterow, 1)) Then
                    'loop the columns to paste the monthly data into daily array
                    For xx = 2 To UBound(dailydataarray, 2)
                        dailydataarray(dailydaterow + 1, xx) = monthlydataarray(monthlydaterow, xx)
                    Next xx
                End If
            Next dailydaterow
        Next monthlydaterow

        'do one more loop to repaste the last date of the month properly            
        For monthlydaterow = 1 To UBound(monthlydatesarray)
            For dailydaterow = 1 To UBound(dailydatesarray)
                If monthlydatesarray(monthlydaterow) = dailydatesarray(dailydaterow) Then
                    For xx = 2 To UBound(dailydataarray, 2)
                        dailydataarray(dailydaterow, xx) = monthlydataarray(monthlydaterow, xx)
                    Next xx
                End If
            Next dailydaterow
        Next monthlydaterow

            ws.UsedRange.Clear
            wb.Sheets("B").Range("A1").Resize(UBound(dailydataarray, 1), UBound(dailydataarray, 2)) = dailydataarray
            ws.UsedRange.Columns(1).NumberFormat = "yyyy/mm/dd"

    End If
Next ws

'Optimize Macro Speed End
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic

MsgBox "Process Finished"

End Sub

backwards loop should work For monthlydaterow = UBound(monthlydatesarray) To 1 Step -1. Did you have some issue with it when you tried it? — Slai
I think from this example: 01/01 until 30/01 = 5, 31/01 until 27/02 = 10, 28/02 until 30/03 = 3....what you are saying is that all but the last day of a given month are equal to the value of the prior month's end of month day position. For the monthly only. In effect, if you had all the days of the month available this would be a table fill down operation using the existing values. Do you have to repeat for item 1,2 and 3 for each month? — QHarr
@Slai when I tried the backwards loop I had a similar problem as how to refer to the previous month date, both are giving me the same trouble. — DGMS89
@QHarr Yes it is basically it. I have a table with all working dates already (my dailydataarray), and I am trying to past the data from the monthly array into it, exactly in the way you understood. The xx loop in the code is for the columns (for each item, that I have several thousand). So basically, I loop the monthly dates, then daily dates then column items (this is where I am stuck). — DGMS89
if the single values are in, you can use powerquery to do table fill down. I know you are seeking a code solution, and I am pondering that at present, but this was an additional muse. — QHarr

QHarr QHarr · Accepted Answer · 2018-03-11T20:30:25

Try the following and let me know if you want adapting. Should really dynamically determine the last column. Possibly could even use UsedRange but lets see if this works for starters. Assumes data starts with header in A1. I may be able to factor out some more but it's beach time!

Note: You would want to output array, at end, to somewhere else so as not to overwrite your existing data (which I believe has many more columns)

If you want to populate last month as well use version 1. If you want to exclude populating last month forwards use version 2. Just be sure to use the function with both versions. Also, ensure output first column is formatted as date.

Version 1

Option Explicit

Public Sub RepeatData1()

Dim wb As Workbook
Dim ws As Worksheet
Dim lastRow As Long
Dim sourceData As Range

Set wb = ThisWorkbook
Set ws = wb.Worksheets("Sheet7") 'change
lastRow = ws.Cells(ws.Rows.count, "A").End(xlUp).Row 'change to appropriate column to get last row
Set sourceData = ws.Range("A2:D" & lastRow) 'change to get include last column

Dim inputArray()
Dim totalOutRows As Long
Dim i As Long

inputArray = sourceData.Value2

For i = 1 To UBound(inputArray, 1)
    totalOutRows = totalOutRows + GetDaysInMonth(Application.WorksheetFunction.EoMonth(inputArray(i, 1), 1))
Next i

Dim outputArray()
ReDim outputArray(1 To totalOutRows, 1 To UBound(inputArray, 2))
Dim outputRow As Long

outputRow = 1

Dim j As Long

For i = 1 To UBound(inputArray, 1)

    For j = 1 To UBound(inputArray, 2)
        outputArray(outputRow, j) = inputArray(i, j)
    Next j

    Dim k As Long

    For k = 1 To GetDaysInMonth(Application.WorksheetFunction.EoMonth(inputArray(i, 1), 1))

        For j = 1 To UBound(inputArray, 2)

            If j = 1 And outputRow > 1 Then
                outputArray(outputRow, j) = inputArray(i, j) + k - 1
            Else
                outputArray(outputRow, j) = inputArray(i, j)
            End If

        Next j

    outputRow = outputRow + 1

    Next k

Next i


ws.Range("L2").Resize(UBound(outputArray, 1), UBound(outputArray, 2)).Value = outputArray

End Sub

Public Function GetDaysInMonth(ByVal datum As Double) As Long
    GetDaysInMonth = Day(DateSerial(Year(datum), Month(datum) + 1, 1) - 1)
End Function

Version 2:

Option Explicit

Public Sub RepeatData()

Dim wb As Workbook
Dim ws As Worksheet
Dim lastRow As Long
Dim sourceData As Range

Set wb = ThisWorkbook
Set ws = wb.Worksheets("Sheet7") 'change
lastRow = ws.Cells(ws.Rows.count, "A").End(xlUp).Row 'change to appropriate column to get last row
Set sourceData = ws.Range("A2:D" & lastRow) 'change to get include last column

Dim inputArray()
Dim totalOutRows As Long
Dim i As Long

inputArray = sourceData.Value2

For i = 2 To UBound(inputArray, 1)   
    totalOutRows = totalOutRows + GetDaysInMonth(inputArray(i, 1))   
Next i

totalOutRows = totalOutRows + 1

Dim outputArray()
ReDim outputArray(1 To totalOutRows, 1 To UBound(inputArray, 2))
Dim outputRow As Long

outputRow = 1

Dim j As Long

For i = 1 To UBound(inputArray, 1) - 1

    For j = 1 To UBound(inputArray, 2)     
        outputArray(outputRow, j) = inputArray(i, j)     
    Next j

    Dim k As Long

    For k = 1 To GetDaysInMonth(inputArray(i + 1, 1))

        For j = 1 To UBound(inputArray, 2)

            If j = 1 And outputRow > 1 Then
                outputArray(outputRow, j) = inputArray(i, j) + k - 1
            Else
                outputArray(outputRow, j) = inputArray(i, j)
            End If

        Next j

    outputRow = outputRow + 1

    Next k

Next i

For j = 1 To UBound(inputArray, 2)
    outputArray(UBound(outputArray, 1), j) = inputArray(UBound(inputArray, 1), j)
Next j

ws.Range("L2").Resize(UBound(outputArray, 1), UBound(outputArray, 2)).Value = outputArray

End Sub

Transforming data from monthly to daily

1 Answers