Multiple Array Calculations

Question

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.

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

I don't understand what your question is. Don't you already have what you need in column AB above? What do you need help with? — RBarryYoung, Aug 31 '21 at 16:01
Column AB is simulated showing what the output should be. The above script works w/out column K. I need it to work with the column K logic added. If you run the script above it would log the first row in Sheet1. Once the logic of column K is added it would ignore the first row and not log it since the Location is not between 0>1 it is 20. — mjac, Aug 31 '21 at 16:05

score 3 · Accepted Answer · answered Aug 31 '21 at 22:16

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

any help with this question is much appreciated. Thank you for your assistance. https://stackoverflow.com/questions/71529697/copy-paste-data-log-based-on-a-condition — mjac, Mar 18 '22 at 16:15

Multiple Array Calculations

1 Answers1

Linked