User4567890
User4567890

Reputation: 13

Append any matching cell value

I have a sheet with a bunch of items, each with an ID number, a description, the probability (1-5), and a risk value (1-5), and a status. The probability column serves as the Y axis in the matrix below, the risk column serves as the X axis. So for each (x,y) combination possible, I want the corresponding ID number and Status to append in to the correct cell in the matrix. So for example, with values where probability=1 and risk= 1, the A1 cell in the risk matrix is updated for the ID and Status of that item.

Risk Matrix Risk Matrix Output Desired

A sample of my data: Small sample of cells

Upvotes: 1

Views: 152

Answers (1)

learnAsWeGo
learnAsWeGo

Reputation: 2282

Main - You (should) Only Have To Change The Ranges of the Matrix and the Id Numbers

Sub main()

Dim wsMatrix                            As Worksheet
Dim wsData                              As Worksheet
Dim RiskMatrixCells                     As range
Dim idsToAppend                         As range
Dim riskMatrixAddresses                 As Variant

    Set wsMatrix = Sheets("Matrix")
    Set wsData = Sheets("Data")

    Set RiskMatrixCells = wsMatrix.range("C3:G7")
    riskMatrixAddresses = GetArrayOfRangeAddresses(RiskMatrixCells)

    Set idsToAppend = wsData.range("A2:A11")
    Call AppendMatrixWithIds(riskMatrixAddresses, idsToAppend, wsMatrix)
End Sub

First Function

Function GetArrayOfRangeAddresses(ByRef targetRng As range) As Variant()
Dim numTargetRngRows                    As Integer
Dim numTargetRngColumns                 As Integer
Dim currentCell                         As range
Dim arrayOfRangeAddresses               As Variant

    numTargetRngRows = targetRng.Rows.Count - 1
    numTargetRngColumns = targetRng.Columns.Count - 1

    ReDim arrayOfRangeAddresses(numTargetRngRows, numTargetRngColumns)
        x = 0
        y = 0
        For Each currentCell In targetRng
            arrayOfRangeAddresses(x, y) = CStr(Replace(currentCell.AddressLocal, "$", ""))
            If y = numTargetRngRows Then
                y = 0
                x = x + 1
            Else
            y = y + 1
            End If
        Next currentCell
    GetArrayOfRangeAddresses = arrayOfRangeAddresses
End Function

Second Function

Sub AppendMatrixWithIds(ByRef matrixArray As Variant, ByVal idsToAppend As Range, ByRef ws As Worksheet)
Dim currentCell As Range
Dim prob                               As Long
Dim risk                               As Long
Dim status                             As String

    For Each currentCell In idsToAppend
        prob = currentCell.Worksheet.Cells(currentCell.Row, 3)
        risk = currentCell.Worksheet.Cells(currentCell.Row, 4)
        status = currentCell.Worksheet.Cells(currentCell.Row, 5)

        ws.Range(matrixArray(prob - 1, risk - 1)).Value = currentCell.Value + "|" + status _
        + " " + ws.Range(matrixArray(prob - 1, risk - 1)).Value
    Next currentCell
End Sub

enter image description here

enter image description here

Upvotes: 2

Related Questions