Home > Enterprise >  Writing values in an array to an excel range - VBA
Writing values in an array to an excel range - VBA

Time:05-06

I am trying to write values from an array to a range (just one row) into an excel sheet. The vba script asks for a start and end date, and then generates the months for those dates in a specific format MMMYY (Jan19, Feb19, Mar19, etc). It stores each of those values in an array. Then I want it to write those values to a row in the excel sheet based on a selected cell where those values would start. With what I have written it only writes Jan19 across the row. I've messed around with it but I am not sure what I am doing wrong. I appreciate the help! Here is what I have so far.

Sub AddYearHeaders()
    Dim ws As Worksheet
    Set ws = ActiveSheet
    
    Dim dtStart As Date
    Dim dtEnd As Date
    Dim iCtr As Integer

    Dim rStCell As Range
    Dim row As Integer
    Dim intStCol As Integer

    Dim arr() As Variant
    
    dtStart = InputBox("Please input start date of period (mm/dd/yyyy)", "User Input", "Enter start date HERE")
    dtEnd = InputBox("Please input end date of period (mm/dd/yyyy)", "User Input", "Enter end date HERE")
    
    iCtr = DateDiff("m", dtStart, dtEnd)
    
    Set rStCell = Application.InputBox(Prompt:="Please select a cell", Type:=8)
    
    row = rStCell.row
    intStCol = rStCell.Column
    
    For I = 0 To iCtr
        
        ReDim Preserve arr(0, I)
        
        arr(0, I) = Format(dtStart, "MMMYY")
        
        dtStart = DateAdd("m", 1, dtStart)
        
    Next I
    
    rStCell.Resize(1, UBound(arr, 2)   1) = WorksheetFunction.Transpose(arr)

End Sub

CodePudding user response:

This should do it...

rStCell.Resize(1, I) = arr

CodePudding user response:

You might want to omit the entire looping part and replace the last line by a function assignment as follows:

    rStCell.Resize(1,iCtr 1) = getMonths(dtStart, dtEnd)

Help function getMonths()

Evaluates tabular formulae resulting in a 1-based 2-dim "1-column" array of date string elements which have to be transposed to get a "flat", i.e. 1-row array.

Function getMonths(ByVal dtStart As Date, dtEnd As Date)
    Dim arr As Variant
    arr = Application.Transpose(Evaluate("TEXT(DATE(" & Year(dtStart) & ",row(" & Month(dtStart) & ":" & Month(dtStart)   DateDiff("m", dtStart, dtEnd) & "),1),""mmmyy"")"))
    getMonths = arr
End Function

  • Related