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
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