Formula Help

Newbie73 · Jun 26, 2024

Hello, I have the following formula:

=MAP(F2:F9904,LAMBDA(x,IF(x="R",LET(c,C2:C9904,r,ROW(c),s,ROW(x),y,(r>=s-8)*(r<s-0)+(r>s+0)*(r<=s+8),SUM(y*(c>"B0"))/SUM

),"")))

And this is the example spreadsheet:

Example.xlsx

Explaining the best I can, if F="R" then check the 8 rows above and below (ignoring the row itself where F="R") and if in the checked rows C is different than "B0" count it and divide it by the total number of rows checked.

This provides me the results on G which is perfect. I was wondering if this formula could be changed slighlty to instead of counting 8 rows above and below (if C different than the value "B0"), to count if C is different than the value "B0" and the date on Column D is within 7 days

So in the example spreadsheet, F2 ="R" so count all the rows that are within 7 days of D2 and that C is different than the value "B0"

I've added the wanted results on Column I

Thank you!

Newbie73 · Jul 1, 2024

Cubist said:
I don't see a more efficient way with the formula. For each cell in the date column, it's checking against the entire date column so say you have 100K rows, so it's checking (100K)^2 times plus other computations. Are you open to the VBA option? That might be more efficient.

I've just started dealing with VBA yesterday, pretty much in the early days of knowing what to do with it, but I'm willing to give it a try!

Cubist · Jul 1, 2024

Try this on a copy of your actual data. It should tell you the runtime in seconds at the end. See if this makes a difference.

VBA Code:

Sub StoreValuesInArrays()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long, j As Long
    Dim dateArr() As Variant
    Dim gradeArr() As Variant
    Dim rArr() As Variant
    Dim resultArr() As Variant
    Dim t As Double: t = Timer
    
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Change sheet name as needed
    lastRow = ws.Cells(ws.Rows.count, "A").End(xlUp).Row
    dateArr = ws.Range("A2:A" & lastRow).Value
    gradeArr = ws.Range("D2:D" & lastRow).Value
    rArr = ws.Range("K2:K" & lastRow).Value
    ReDim resultArr(1 To UBound(dateArr, 1), 1 To 1)
    
    For i = LBound(rArr, 1) To UBound(rArr, 1)
        If rArr(i, 1) = "R" Then
            Dim currentDate As Date
            currentDate = dateArr(i, 1)
            
            Dim totalCount As Long
            totalCount = 0
            Dim b0Count As Long
            b0Count = 0
            
            'Count B0 and total # days
            For j = LBound(dateArr, 1) To UBound(dateArr, 1)
                If i <> j And Abs(DateDiff("d", currentDate, dateArr(j, 1))) <= 7 Then
                    totalCount = totalCount + 1
                    If gradeArr(j, 1) <> "B0" Then
                        b0Count = b0Count + 1
                    End If
                End If
            Next j
            
            ' Calculate probability resultArr
            If totalCount > 0 Then
                resultArr(i, 1) = b0Count / totalCount
            Else
                resultArr(i, 1) = 0
            End If
        End If
    Next i
    
    ' Output the result array to column N starting at N2
    ws.Range("N2").Resize(UBound(resultArr, 1), 1).Value = resultArr
    MsgBox "Runtime (seconds): " & Round(Timer - t, 2)
End Sub

Cubist · Jul 1, 2024

I looked at your sample in the OP there's a 4/29 entry that is before 4/11 not sure if that's just a mistake but if your data is truly sorted from oldest to newest, then add one additional line should speed it up more.

VBA Code:

Sub StoreValuesInArrays()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long, j As Long
    Dim dateArr() As Variant
    Dim gradeArr() As Variant
    Dim rArr() As Variant
    Dim resultArr() As Variant
    Dim t As Double: t = Timer
   
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Change sheet name as needed
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    dateArr = ws.Range("A2:A" & lastRow).Value
    gradeArr = ws.Range("D2:D" & lastRow).Value
    rArr = ws.Range("K2:K" & lastRow).Value
    ReDim resultArr(1 To UBound(dateArr, 1), 1 To 1)
   
    For i = LBound(rArr, 1) To UBound(rArr, 1)
        If rArr(i, 1) = "R" Then
            Dim currentDate As Date
            currentDate = dateArr(i, 1)
           
            Dim totalCount As Long
            totalCount = 0
            Dim b0Count As Long
            b0Count = 0
           
            'Count B0 and total # days
            For j = LBound(dateArr, 1) To UBound(dateArr, 1)
                If dateArr(j, 1) > currentDate + 7 Then Exit For 'Comment this out if the date is not sorted. Keep if date is sorted from oldest to newest.
                If i <> j And Abs(DateDiff("d", currentDate, dateArr(j, 1))) <= 7 Then
                    totalCount = totalCount + 1
                    If gradeArr(j, 1) <> "B0" Then
                        b0Count = b0Count + 1
                    End If
                End If
            Next j
            ' Calculate probability resultArr
            If totalCount > 0 Then
                resultArr(i, 1) = b0Count / totalCount
            Else
                resultArr(i, 1) = 0
            End If
        End If
    Next i
   
    ' Output the result array to column N starting at N2
    ws.Range("N2").Resize(UBound(resultArr, 1), 1).Value = resultArr
    MsgBox "Runtime (seconds): " & Round(Timer - t, 2)
End Sub

Newbie73 · Jul 1, 2024

Cubist said:

I looked at your sample in the OP there's a 4/29 entry that is before 4/11 not sure if that's just a mistake but if your data is truly sorted from oldest to newest, then add one additional line should speed it up more.

VBA Code:

Sub StoreValuesInArrays()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long, j As Long
    Dim dateArr() As Variant
    Dim gradeArr() As Variant
    Dim rArr() As Variant
    Dim resultArr() As Variant
    Dim t As Double: t = Timer
  
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Change sheet name as needed
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    dateArr = ws.Range("A2:A" & lastRow).Value
    gradeArr = ws.Range("D2:D" & lastRow).Value
    rArr = ws.Range("K2:K" & lastRow).Value
    ReDim resultArr(1 To UBound(dateArr, 1), 1 To 1)
  
    For i = LBound(rArr, 1) To UBound(rArr, 1)
        If rArr(i, 1) = "R" Then
            Dim currentDate As Date
            currentDate = dateArr(i, 1)
          
            Dim totalCount As Long
            totalCount = 0
            Dim b0Count As Long
            b0Count = 0
          
            'Count B0 and total # days
            For j = LBound(dateArr, 1) To UBound(dateArr, 1)
                If dateArr(j, 1) > currentDate + 7 Then Exit For 'Comment this out if the date is not sorted. Keep if date is sorted from oldest to newest.
                If i <> j And Abs(DateDiff("d", currentDate, dateArr(j, 1))) <= 7 Then
                    totalCount = totalCount + 1
                    If gradeArr(j, 1) <> "B0" Then
                        b0Count = b0Count + 1
                    End If
                End If
            Next j
            ' Calculate probability resultArr
            If totalCount > 0 Then
                resultArr(i, 1) = b0Count / totalCount
            Else
                resultArr(i, 1) = 0
            End If
        End If
    Next i
  
    ' Output the result array to column N starting at N2
    ws.Range("N2").Resize(UBound(resultArr, 1), 1).Value = resultArr
    MsgBox "Runtime (seconds): " & Round(Timer - t, 2)
End Sub

Those dates were examples, on the other sheet I've posted here those have real dates which will always be sorted from older to newer. Will give this a try later one if I have time, thank you so much!

Newbie73 · Jul 1, 2024

I've just gave it a try and so much better! I mean I know I still need to repeat this and change it to several variations, but it was 0.2 seconds! Looks promising but also for some reason it only did just over 100 rows? And seems to do calculations in all of the rows, but it really just needs to for example in this case, when K ="R", if it's blank or zero it can skip it.

Did small changes but just on names/ ranges, don't think I've messed something up

Sub StoreValuesInArrays()
Dim ws As Worksheet
Dim lastRow As Long, i As Long, j As Long
Dim dateArr() As Variant
Dim gradeArr() As Variant
Dim rArr() As Variant
Dim resultArr() As Variant
Dim t As Double: t = Timer

Set ws = ThisWorkbook.Sheets("NearbyTagsDOB(2)") ' Change sheet name as needed
lastRow = ws.Cells(ws.Rows.Count, "H").End(xlUp).Row
dateArr = ws.Range("H2:H" & lastRow).Value
gradeArr = ws.Range("C2:C" & lastRow).Value
rArr = ws.Range("AI2:AI" & lastRow).Value
ReDim resultArr(1 To UBound(dateArr, 1), 1 To 1)

For i = LBound(rArr, 1) To UBound(rArr, 1)
If rArr(i, 1) = "R" Then
Dim currentDate As Date
currentDate = dateArr(i, 1)

Dim totalCount As Long
totalCount = 0
Dim b0Count As Long
b0Count = 0

'Count B0 and total # days
For j = LBound(dateArr, 1) To UBound(dateArr, 1)
If dateArr(j, 1) > currentDate + 7 Then Exit For 'Comment this out if the date is not sorted. Keep if date is sorted from oldest to newest.
If i <> j And Abs(DateDiff("d", currentDate, dateArr(j, 1))) <= 7 Then
totalCount = totalCount + 1
If gradeArr(j, 1) <> "B0" Then
b0Count = b0Count + 1
End If
End If
Next j
' Calculate probability resultArr
If totalCount > 0 Then
resultArr(i, 1) = b0Count / totalCount
Else
resultArr(i, 1) = 0
End If
End If
Next i

' Output the result array to column N starting at N2
ws.Range("AZ2").Resize(UBound(resultArr, 1), 1).Value = resultArr
MsgBox "Runtime (seconds): " & Round(Timer - t, 2)
End Sub

And just double checking, this VBA is for this formula =IF(K2:K10000="R",MAP(A2:A10000,LAMBDA(m,LET(c,D2:D10000,d,A2:A10000,k,(d>=m-7)*(d<=m+7)*(m<>d),IFERROR(SUM(k*(c<>"B0"))/SUM(k),0)))),"")

So the same date or 7 days before or after than the date correct? Just double checking, still getting used to read and understand things in VBA.

Cubist · Jul 1, 2024

To make things a little more flexible, we can change the VBA into a custom function. There are two versions: 1) WITHIN and 2) OR case. To call the user-defined function (UDF), use it like the ordinary functions. I have not checked the math for the OR case but you can probably modify that yourself as needed. When the daysbefore & daysafter parameters are omitted, I've set the default to 7. Let me know if you have any questions.

PS: when posting code, use the code tags to keep your code indented and the keyword highlighted.

Book1 (version 2).xlsb

A

B

C

D

E

1

Grade

Date

R

Within 7 days

7 to 14 days before OR 7 to 14 days after

2

B5

3/28/99

IR

3

B0

6/25/99

R

0.0%

4

B0

7/11/99

R

0.0%

5

B0

2/3/00

IR

6

B0

4/10/00

R

0.0%

7

B0

9/11/00

R

0.0%

8

B1

9/29/00

R

0.0%

9

B0

10/27/00

IR

10

B0

12/15/00

IR

11

B5

6/21/01

R

0.0%

100.0%

12

B5

7/3/01

IR

13

B0

9/25/01

R

0.0%

14

B0

3/14/02

IR

15

B0

4/14/02

R

0.0%

16

B0

5/18/02

R

0.0%

17

B0

8/1/02

R

0.0%

18

B0

8/24/02

IR

19

B0

11/23/02

IR

20

B0

12/8/02

IR

Sheet2

Cell Formulas
Range	Formula
D2:D2200	D2	=CalculateProb(B2:B2200,A2:A2200,C2:C2200,"R","B0")
E2:E2200	E2	=CalculateProbOR(B2:B2200,A2:A2200,C2:C2200,"R","B0",7,14)
Dynamic array formulas.

VBA Code:

Function CalculateProb(dateRange As Range, gradeRange As Range, rRange As Range, _
                                           checkString As String, gradeCheckString As String, _
                                           Optional daysBefore As Long = 7, Optional daysAfter As Long = 7) As Variant
                                        
    Dim lastRow As Long, i As Long, j As Long
    Dim dateArr() As Variant
    Dim gradeArr() As Variant
    Dim rArr() As Variant
    Dim resultArr() As Variant

    ' Store values in the arrays
    dateArr = dateRange.Value
    gradeArr = gradeRange.Value
    rArr = rRange.Value
    ReDim resultArr(1 To UBound(dateArr, 1), 1 To 1)

    For i = LBound(rArr, 1) To UBound(rArr, 1)
        If rArr(i, 1) = checkString Then
            Dim currentDate As Date
            currentDate = dateArr(i, 1)

            Dim totalCount As Long
            totalCount = 0
            Dim gradeCount As Long
            gradeCount = 0

            ' Count gradeCheckString and total # days
            For j = LBound(dateArr, 1) To UBound(dateArr, 1)
                If dateArr(j, 1) > currentDate + daysAfter Then Exit For
                If dateArr(j, 1) >= currentDate - daysBefore And dateArr(j, 1) <= currentDate + daysAfter Then
                    If dateArr(j, 1) <> currentDate Then
                        totalCount = totalCount + 1
                        If gradeArr(j, 1) <> gradeCheckString Then
                            gradeCount = gradeCount + 1
                        End If
                    End If
                End If
            Next j

            ' Calculate probability resultArr
            If totalCount > 0 Then
                resultArr(i, 1) = gradeCount / totalCount
            Else
                resultArr(i, 1) = 0
            End If
        Else
            resultArr(i, 1) = ""
        End If
    Next i

    ' Return the result array
    CalculateProb = resultArr
End Function

VBA Code:

Function CalculateProbOR(dateRange As Range, gradeRange As Range, rRange As Range, checkString As String, gradeCheckString As String, Optional daysBefore As Long = 7, Optional daysAfter As Long = 7) As Variant
    Dim lastRow As Long, i As Long, j As Long
    Dim dateArr() As Variant
    Dim gradeArr() As Variant
    Dim rArr() As Variant
    Dim resultArr() As Variant
 
    ' Store values in the arrays
    dateArr = dateRange.Value
    gradeArr = gradeRange.Value
    rArr = rRange.Value
    ReDim resultArr(1 To UBound(dateArr, 1), 1 To 1)
 
    For i = LBound(rArr, 1) To UBound(rArr, 1)
        If rArr(i, 1) = checkString Then
            Dim currentDate As Date
            currentDate = dateArr(i, 1)
         
            Dim totalCount As Long
            totalCount = 0
            Dim gradeCount As Long
            gradeCount = 0
         
            ' Count gradeCheckString and total # days
            For j = LBound(dateArr, 1) To UBound(dateArr, 1)
                If dateArr(j, 1) > currentDate + daysAfter Then Exit For
                If (dateArr(j, 1) >= currentDate - daysBefore And dateArr(j, 1) <= currentDate - daysAfter) Or _
                   (dateArr(j, 1) >= currentDate + daysBefore And dateArr(j, 1) <= currentDate + daysAfter) Then
                    totalCount = totalCount + 1
                    If dateArr(j, 1) <> currentDate And gradeArr(j, 1) <> gradeCheckString Then
                        gradeCount = gradeCount + 1
                    End If
                End If
            Next j
         
            ' Calculate probability resultArr
            If totalCount > 0 Then
                resultArr(i, 1) = gradeCount / totalCount
            Else
                resultArr(i, 1) = 0
            End If
        Else
            resultArr(i, 1) = ""
        End If
    Next i
 
    ' Return the result array
    CalculateProbOR = resultArr
End Function

Newbie73 · Jul 1, 2024

Thanks, will do that next time I add some code.

It looks really promising! Only gave it one try and seems to be working perfectly and blazing fast

I won't have time to try it more today as I won't be in the computer but tomorrow I will test it further.

Really grateful, thank you Cubist!

Newbie73 · Jul 2, 2024

Just managed to get some time to play around with it, the within is working perfectly and matching results with your previously formula, but not the OR. This is with the 7,14 option

Example: Column E is with the OR formula/VBA and F with your previously formula =IF(C1:C9999="R",MAP(A1:A9999,LAMBDA(m,LET(c,B1:B9999,d,A1:A9999,k,(d>=m-14)*(d<=m-7)+(d>=m+7)*(d<=m+14)*(m<>d),IFERROR(SUM(k*(c<>"B0"))/SUM(k),0)))),"")

Should be same result both ways as they are both within 7-14 days range and your previously formula is detecting that giving 100% on both, but not the new one with VBA? I've tried to look at the code but can't really figure out why is that happening.

Any ideas?

12/01/2004	B1	R		100%	100%
22/01/2004	B5	R		0%	100%

Cubist · Jul 2, 2024

Your formula is missing parenthesis.

Rich (BB code):

=IF(C1:C9999="R",MAP(A1:A9999,LAMBDA(m,LET(c,B1:B9999,d,A1:A9999,k,((d>=m-14)*(d<=m-7)+(d>=m+7)*(d<=m+14))*(m<>d),IFERROR(SUM(k*(c<>"B0"))/SUM(k),0)))),"")

I made slight modifications to the OR, but the results should match.

VBA Code:

Function CalculateProbOR(dateRange As Range, gradeRange As Range, rRange As Range, _
                        checkString As String, gradeCheckString As String, _
                        Optional daysBefore As Long = 7, Optional daysAfter As Long = 7) As Variant
                        
    Dim lastRow As Long, i As Long, j As Long
    Dim dateArr() As Variant
    Dim gradeArr() As Variant
    Dim rArr() As Variant
    Dim resultArr() As Variant
 
    ' Store values in the arrays
    dateArr = dateRange.Value
    gradeArr = gradeRange.Value
    rArr = rRange.Value
    ReDim resultArr(1 To UBound(dateArr, 1), 1 To 1)
 
    For i = LBound(rArr, 1) To UBound(rArr, 1)
        If rArr(i, 1) = checkString Then
            Dim currentDate As Date
            currentDate = dateArr(i, 1)
         
            Dim totalCount As Long
            totalCount = 0
            Dim gradeCount As Long
            gradeCount = 0
         
            ' Count gradeCheckString and total # days
            For j = LBound(dateArr, 1) To UBound(dateArr, 1)
                If dateArr(j, 1) > currentDate + daysAfter Then Exit For
                If (dateArr(j, 1) >= currentDate - daysAfter And dateArr(j, 1) <= currentDate - daysBefore) Or _
                   (dateArr(j, 1) >= currentDate + daysBefore And dateArr(j, 1) <= currentDate + daysAfter) Then
                    totalCount = totalCount + 1
                    If dateArr(j, 1) <> currentDate And gradeArr(j, 1) <> gradeCheckString Then
                        gradeCount = gradeCount + 1
                    End If
                End If
            Next j
         
            ' Calculate probability resultArr
            If totalCount > 0 Then
                resultArr(i, 1) = gradeCount / totalCount
            Else
                resultArr(i, 1) = 0
            End If
        Else
            resultArr(i, 1) = ""
        End If
    Next i
 
    ' Return the result array
    CalculateProbOR = resultArr
End Function

Newbie73 · Jul 2, 2024

Not sure what you've changed but it's matching now!! One last question... If I were to run an adaption where I only wants days after (or before but not together). Is there a easy way of doing it? Would I change this numbers in the code:

VBA Code:

daysBefore As Long = 7, Optional daysAfter As Long = 7) As Variant

And delete for example this line if it was to do only for days after:

VBA Code:

(dateArr(j, 1) >= currentDate - daysAfter And dateArr(j, 1) <= currentDate - daysBefore) Or _

Basically to try to achieve this adaptation of your formula:

=IF(AY2:AY10000="R",MAP(H2:H10000,LAMBDA(m,LET(c,C2:C10000,d,H2:H10000,k,(d>=m-0)*(d<=m+7)*(m<>d),IFERROR(SUM(k*(c<>"B0"))/SUM(k),0)))),"")

Or

=IF(AY2:AY10000="R",MAP(H2:H10000,LAMBDA(m,LET(c,C2:C10000,d,H2:H10000,k,(d>=m+7)*(d<=m+14)*(m<>d),IFERROR(SUM(k*(c<>"B0"))/SUM(k),0)))),"")

I think it's the last question as everything else seems to be working as intended! Sorry about it again and thank you. I will reply and play with it tomorrow

Formula Help

Newbie73

Board Regular

Newbie73

Board Regular

Excel Facts

Cubist

Well-known Member

Cubist

Well-known Member

Newbie73

Board Regular

Newbie73

Board Regular

Cubist

Well-known Member

Newbie73

Board Regular

Newbie73

Board Regular

Cubist

Well-known Member

Newbie73

Board Regular

Similar threads

Forum statistics

Share this page

Formula Help

Board Regular

Board Regular

Excel Facts

Well-known Member

Well-known Member

Board Regular

Board Regular

Well-known Member

Board Regular

Board Regular

Well-known Member

Board Regular

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock