Multiple Array Calculations

124 views Asked by At

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
1

There are 1 answers

2
Tim Williams On BEST ANSWER

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