Search code examples
arraysexcelvbaworksheet-functionrtd

Multiple Array Calculations


Script below runs a array difference calculation then processes the data further if other criteria is met. I need to add one additional criteria to filter the data further before it logs the final output to Sheet1. Need to add the "Location" in column "K" so it filters the data first before it logs it to Sheet1. enter image description here

Code in Module 1

Public Sub PopulateMyArr()
myArr = Sheet4.Range("I6:I500").Value
End Sub

Code in This Workbook

Private Sub Workbook_Open()
PopulateMyArr
End Sub

Code in Sheet4 (BA_Size)

Private Sub Worksheet_Calculate()

Dim keyCells As Range, i As Long, diff, cKey As Range

'exit if togglebutton not on
If Not Worksheets("BA_Size").ToggleButton1.Value Then Exit Sub

On Error GoTo safeexit
Application.EnableEvents = False

Set keyCells = Me.Range("I6:I500")
nextrow = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row + 1

For i = 1 To UBound(myArr)
    Set cKey = keyCells(i, 1)
    If cKey.Value <> myArr(i, 1) Then
        diff = (cKey.Value - myArr(i, 1))
        'check value in Col L
        Select Case cKey.EntireRow.Columns("L").Value
            Case "John": diff = diff * cKey.EntireRow.Columns("O").Value
            Case "Mary": diff = diff * cKey.EntireRow.Columns("P").Value
            Case Else: diff = 0
        End Select
        Sheet1.Cells(nextrow, "A").Value = diff
        nextrow = nextrow + 1
    End If
Next i
  
safeexit:
PopulateMyArr
Application.EnableEvents = True
End Sub

Solution

  • Untested:

    Private Sub Worksheet_Calculate()
    
        Dim keyCells As Range, i As Long, diff, cKey As Range, kVal
        
        'exit if togglebutton not on
        If Not Worksheets("BA_Size").ToggleButton1.Value Then Exit Sub
        
        On Error GoTo safeexit
        Application.EnableEvents = False
        
        Set keyCells = Me.Range("I6:I500")
        nextrow = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row + 1
        
        For i = 1 To UBound(myArr)
            Set cKey = keyCells(i, 1)
            kVal = cKey.EntireRow.Columns("K").Value ' << read from K
            If kVal >= 0 And kVal <= 1 Then          ' << check the value
                If cKey.Value <> myArr(i, 1) Then 
                    diff = (cKey.Value - myArr(i, 1))
                    'check value in Col L
                    Select Case cKey.EntireRow.Columns("L").Value
                        Case "John": diff = diff * cKey.EntireRow.Columns("O").Value
                        Case "Mary": diff = diff * cKey.EntireRow.Columns("P").Value
                        Case Else: diff = 0
                    End Select
                    Sheet1.Cells(nextrow, "A").Value = diff
                    nextrow = nextrow + 1
                End If
            End If 'K value is between 0 and 1
        Next i
          
    safeexit:
        PopulateMyArr
        Application.EnableEvents = True
    End Sub