Excel Populate column with Multi-Dimensional Array

Question

I have a table with five columns: Project #, Phase #, $$$$, Completion % M1, Completion % M2

I am trying to write a code that takes the transfers Completion % M2 to Completion % M1 when the Data gets updated. The data gets updated every month and sometimes project numbers drop off or phases are added to projects.

What I am struggling to figure out is if I can use a multi-dimensional array to store the data, then sort it to match the new data and update the corresponding cells.

Option Explicit

'Public variable to define date at woorkbook initialization (start-up)
Public inDate As Date

'Public variable to define table length at woorkbook initialization (start-up)
Public intTotalRows As Long

'Public variables to define PM % complete arrays
Public strArray0() As Variant

Sub LoadArray2()

    Dim i As Long
    Dim n As Long
    
    'Set Array element length
    ReDim strArray0(intTotalRows, 3)

    'Collect PM enetered % complete information
    For i = 1 To intTotalRows
        strArray0(i, 1) = Worksheets("Stream 3 Month Financial Review").Cells(i + 1, 1).Value
        strArray0(i, 2) = Worksheets("Stream 3 Month Financial Review").Cells(i + 1, 2).Value
        strArray0(i, 3) = Worksheets("Stream 3 Month Financial Review").Cells(i + 1, 5).Value
    Next
    
End Sub


Private Sub Workbook_Open()

    ' Get previous data pull date prior to pull updating (Get Data)
    inDate = Worksheets("Data Pull Date").Range("F2")
    Debug.Print ("inDate " & inDate)
    
    Dim tbl1 As ListObject
    ' Count # of Rows in Raw Data Table prior to pull updating (Get Data)
    Set tbl1 = Worksheets("Raw Data (Transformed)").ListObjects("Stream_Data_Centers_3_Month_Review")
    intTotalRows = tbl1.Range.Rows.Count - 1
    Debug.Print ("intTotalRows " & intTotalRows)
    
End Sub


Private Sub Worksheet_TableUpdate(ByVal Target As TableObject)

    Dim curDate As Date
    Dim curTotalRows As Long

    'Get current data pull date after pull updating (Get Data)
    curDate = Worksheets("Data Pull Date").Range("F2")
    Debug.Print ("curDate " & curDate)
    
    'Update PM entered % Complete if curDate is month after inDate
    If Month(curDate) = Month(inDate) Then
        'nothing
    Else
        LoadArray2
        'Shift PM % Complete value over to left, Clear Last Row
        For i = 1 To intTotalRows
            Worksheets("Stream 3 Month Financial Review").Cells(i + 1, 4).Value = strArray1(i)
        Next
    End If
    
End Sub

I need a code to take strArray0(i, 3) and populate column 4 with the data if strArray0(i, 1) and strArray0(i, 2) match the value is columns 1 and 2.

I decided to add a column in the transformed data to create a UID for each line. So now I just need to match strArray0(i, 1) to a value in column 1.

Answer 1

I used a few work arounds to make it happen but here is the code:

Private Sub Workbook_Open()

    MsgBox ("Please wait while the data refreshes. This may take a minute.")

    ' Get previous data pull date prior to query updating (Get Data)
    inDate = Worksheets("Data Pull Date").Range("F2")
    Debug.Print ("inDate " & inDate)
    
    LoadArray2
    
    'Refresh Query Tables after LoadArray2 has ran.
    ActiveWorkbook.RefreshAll
    
End Sub

The above code runs while the workbook opens and defines some variables and collects user inputs prior to refreshing the data in the query tables. Then after the data has refreshed it triggers this code to run:

Private Sub Worksheet_TableUpdate(ByVal Target As TableObject)

    'Variable to define date after Query table update
    Dim curDate As Date
    
    curDate = Worksheets("Data Pull Date").Range("F2")
    Debug.Print ("curDate: " & curDate)

    If Month(curDate) <> Month(inDate) Then
        LookupArray
        MsgBox ("PM % Complete Estimates have been updated using last month's projections.")
    Else
        MsgBox ("Your data is ready.")
    End If
    
    inDate = curDate
    
    
End Sub

The key to making the Worksheet_TableUpdate(ByVal Target As TableObject) method work is to have the query table added to the Data Model. You can do this in the Query Ribbon that pops up when you select the query table. In 'Load To' options, select the box for 'Add this Data to the Data Model'.

Here is Module1 with the called subs and Public variables:

Option Explicit

'Public variable to define date at woorkbook initialization (start-up)
Public inDate As Date

'Public variable to define table length at woorkbook initialization (start-up)
Public intTotalRows As Long

'Public variable to define PM % complete arrays
Public strArray0() As Variant

Sub LoadArray2()

    Dim i As Long
    Dim disVal As Variant
    Dim tbl1 As ListObject
    
    ' Count # of Rows in Raw Data Table prior to pull updating (Get Data)
    Set tbl1 = Worksheets("Stream 3 Month Financial Review").ListObjects("Table3")
    intTotalRows = tbl1.Range.Rows.Count - 1
    
    'Set Array element length
    ReDim strArray0(1 To intTotalRows, 1 To 4)
    
    'Collect PM enetered % complete information
    For i = 1 To intTotalRows
        strArray0(i, 1) = Worksheets("Stream 3 Month Financial Review").Cells(i + 1, 9).Value
        strArray0(i, 2) = Worksheets("Stream 3 Month Financial Review").Cells(i + 1, 11).Value
        strArray0(i, 3) = Worksheets("Stream 3 Month Financial Review").Cells(i + 1, 12).Value
        strArray0(i, 4) = Worksheets("Stream 3 Month Financial Review").Cells(i + 1, 13).Value
    Next
    
    'Debug check for strArray0 values
    disVal = strArray0(4, 1) & " 1: " & strArray0(4, 2) & " 2: " & strArray0(4, 3) & " 3: " & strArray0(4, 4)
    Debug.Print ("strArray0 " & disVal)
    Debug.Print ("intTotalRows " & intTotalRows)
    
End Sub

Sub LookupArray()

    Dim disVal0 As Variant
    Dim disVal1 As Variant
    Dim ArrayCheck As Variant
    Dim UIDstr As Range
    Dim ColUp As Range
    
    'Check inputs from Public variables.
    ArrayCheck = strArray0(4, 1) & " 1: " & strArray0(4, 2) & " 2: " & strArray0(4, 3) & " 3: " & strArray0(4, 4)
    Debug.Print ("ArrayCheck " & ArrayCheck)
    
    'UID column range
    Set ColUp = Worksheets("Stream 3 Month Financial Review").Range("I2:I979")
    
    On Error Resume Next
    For Each UIDstr In ColUp
        If IsError(UIDstr) Then
        'Nothing
        Else
            disVal0 = Application.WorksheetFunction.VLookup(UIDstr.Value, strArray0, 3, 0)
            disVal1 = Application.WorksheetFunction.VLookup(UIDstr.Value, strArray0, 4, 0)
            UIDstr.Offset(0, 2).Value = disVal0
            UIDstr.Offset(0, 3).Value = disVal1
            UIDstr.Offset(0, 4).Value = ""
        
            'Debug.Print ("Lookup UIDstr: " & UIDstr.Value & " disVal0: " & disVal0 & " disVal1: " & disVal1)
        End If
    Next
    
End Sub