How do I transform multiple columns to a stacked column set of three in VBA?-CodePudding

I have data (see image one) of twelve months columned by Date-Jan, Day, Hours,/ Date-Feb, Day, Hours,/etc... for a total of 36 columns.

I am trying to transform that sheet into a new sheet report style and its should look stacked (see image 2) it should have four columns by Name (of the employee), Date, Day, Hours.

Few things to Note:

It has to be a reference - so when I change the hours in sheet1 in automatically updates in sheet2. NO COPY PASTE. (so like example(=b2)) (no need to be reversed) .

If I try to reiterate by every three columns, keep in mind that every month has a different amount of days and we don't want empty rows.

I was thinking of vlookup or the index function, but cant seem to make it work

CodePudding user response：

Developping a single dynamic formula reference (MS 365)

"It has to be a reference - so when I change the hours in sheet1 in automatically updates in sheet2"

The pre-determined fixed structure lets you a way out to get the wanted dynamic reference. The "escape route" is simply to

recalculate the date values (col 2-Date and 3-Day) as numeric sequence by a formula instead of trying to refer to the original dates,
and to include all needed column results as first step in something like

   =CHOOSE({1,2,3,4},Employee,dt,dt,hours)

As following step you need to enclose all needed column parameters into sort of a formula container (LET()) defining all column inputs, partially by reference to named cells, which could be for example

Employee .. e.g. "Bob Smith")
StartDate .. e.g. 4/1 2021 (equalling here 44291)
StartYear .. e.g. 2021
StartMonth.. e.g. 4

The LET function (available in MS 365) allows to do this in a structured way avoiding some redundancies as well.

    =LET(data,Sheet1!$C$6:$AL$36,dt,SEQUENCE(366,1,StartDate),hours,INDEX(data,DAY(dt),(MONTH(dt) (YEAR(dt)-StartYear)*12-StartMonth)*3 3),CHOOSE({1,2,3,4},Employee,dt,dt,hours))

By entering this formula into any target cell (e.g. in Sheet2) you get a dynamic spill range of four columns with automatic display of changes of original hours.

Hint: I leave it to you to refine the Let formula considering leap years, too.

To get eventually the right report layout for the calculated date sequences (just numbers), you have to format the 2nd and 3rd output columns with the wanted date formats, e.g. "'m\/d" and "[$-409]ddd".

Overview of formula parts

which includes line feeds for better readibility

 =LET(
      data,  Sheet1!$C$6:$AL$36,
      dt,    SEQUENCE(366,1,StartDate),
      hours, INDEX(data,DAY(dt),(MONTH(dt) (YEAR(dt)-StartYear)*12-StartMonth)*3 3),
      CHOOSE({1,2,3,4},Employee,dt,dt,hours)
     )

CodePudding user response：

As @PEH mentioned correctly in comment, there's no "neat solution" regarding changing month lengths and your requirement "It has to be a reference - so when I change the hours in sheet1 in automatically updates in sheet2"

VBA Run-up without direct references

(c.f. ►2nd post developping a single dynamic formula reference)

Due to the fixed structure of your range of 31 x 36 data cells, you could, however

provide for a report array with 31*12 rows and 4 columns (Name,Date,Day,Hours) ,
that you fill with the employee's name (col.1), with calculated dates (assumed: strings!) ranging from 1 to max. 31 days (col. 2 & 3), as well as the hours read in column-wise from source
and write back to any wanted target.

Example call

Change worksheet indications following your needs.

Sub WriteReport()
'A) create report
    Dim report As Variant
    report = getReport("Bob Smith", ThisWorkbook.Worksheets("Sheet1"))
'B) write report to any wanted target
    With Sheet2            
    .Range("A1".resize(1,4) = split("Name,Date,Day,Hours", ",")
    .Range("A2").Resize(UBound(report), UBound(report, 2)) = report
    End With
End Sub

Help function getReport()

Function getReport(ByVal employee As String, _
     SourceSheet As Worksheet, _
     Optional StartYear As Long = 2021, _
     Optional startMonth As Long = 4)
'0) get start dates for e.g. 12 months via  help function getDates()
    Const MonthsCount As Long = 12
    Dim datearr: datearr = getDates(DateSerial(StartYear, startMonth, 1), MonthsCount)
'1) define source range
    Dim rng As Range
    Set rng = SourceSheet.Range("A6").Resize(31, 3 * MonthsCount)
'2) define 1-based 2-dim report array comprising 31 x 4 elements
    Dim report
    ReDim report(1 To MonthsCount * 31, 1 To 4)
'3) add calculated dates and add monthly hours to report array
    Dim mth As Long, d As Long, cnt As Long
    For mth = 1 To MonthsCount
        'get monthly hours as 2-dim array (1 column each)
        Dim monthlyHours: monthlyHours = rng.Columns(mth * 3   2).Value
        For d = 1 To ultimo(datearr(mth))
            cnt = cnt   1
            report(cnt, 1) = employee
            report(cnt, 2) = Application.Text(datearr(mth)   d - 1, "'m\/d")      ' force date string
            report(cnt, 3) = Application.Text(datearr(mth)   d - 1, "[$-409]ddd") ' force EN-US vers.
            report(cnt, 4) = monthlyHours(d, 1)
        Next d
    Next
'4) return function result
    getReport = report
End Function

Help function getDates()

Returns a 1-dim array of the starting date for each month

Function getDates(dt As Date, Optional MonthsCount As Long = 12)
'Purpose: get 1-dim array of last 12 months dates 
'a) get start date
    Dim EndDate As Date: EndDate = DateAdd("m", MonthsCount, dt)
    Dim yrs As Long:     yrs = Year(EndDate) - Year(dt)
'b) get column numbers representing a months sequence
    Dim cols As String
    cols = Split(Cells(, Month(dt)).Address, "$")(1)
    cols = cols & ":" & Split(Cells(, Month(EndDate) - 1   Abs(yrs * 12)).Address, "$")(1)
'c) evaluate dates
    getDates = Evaluate("Date(" & Year(dt) & _
        ",Column(" & cols & "),1)")
End Function

Help function ultimo()

Calculates the last day of a given month date (ranging from 28 to 31). This is possible using zero (0) as theoretical day input and last argument in function getSerial() if applied for the next month (month 1) .

Function ultimo(ByVal dt) As Long
'Purp.: return last day of month
        ultimo = Day(DateSerial(Year(dt), Month(dt)   1, 0))
End Function

CodePudding user response：

I ended up using this formula and it worked.

firstDate = DateValue("4/1/2021")
secondDate = DateValue("4/1/2024")
n = DateDiff("d", firstDate, secondDate)
sc = Sheets.Count
scd = sc - 3
datar = "$A$1:$G$" & scd * n   1


For c = sc - 1 To 3 Step -1
    q = Sheets(c).Name
    Sheets("Report").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Formula2R1C1 = "=SEQUENCE(DAYS(""4/1/2024"",""4/1/2021""),,""4/1/2021"")"
    Sheets("Report").Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Resize(n).Formula2R1C1 = "=TEXT(INDIRECT(""RC[-1]"",0),""ddd"")"
    Sheets("Report").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(n).Formula2R1C1 = Sheets(c).Range("$K$1")
    Sheets("Report").Cells(Rows.Count, 1).End(xlUp).Offset(-n   1, 0).Resize(n).Select
    Selection.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'" & q & "'" & "!$A$1"
    Sheets("Report").Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Resize(n).Formula2R1C1 = "=INDEX(" & q & "!R6C3:R114C38,IF(LARGE((" & q & "!R6C3:R114C38=RC2)*ROW(" & q & "!R6C3:R114C38),1),LARGE((" & q & "!R6C3:R114C38=RC2)*ROW(" & q & "!R6C3:R114C38),1)-5,""""),IFERROR(MATCH(RC2,INDEX(" & q & "!R6C3:R114C38,IF(LARGE((" & q & "!R6C3:R114C38=RC2)*ROW(" & q & "!R6C3:R114C38),1),LARGE((" & q & "!R6C3:R114C38=RC2)*ROW(" & q & "!R6C3:R114C38),1)-5,""""),0),0),"""") 2)"