Writing a custom function with VBA to calculate dBA from linear spectral data

Question

I want to write a custom function that works out the overall A-Weighted dB level of a linear spectrum of octave band frequencies (eg. 31.5 Hz-16kHz). The function would need to have an input of two ranges (e.g. A1-10 with octave mid-band frequencies, and B1-10 with spectral data: L1-L10) and add an attenuation factor to each level in each octave band before summing them logarithmically (10*log10(10^(L1/10)+10^(L2/10)etc.)). I've managed to write one that will do the backend, which is below:

Public Function DBSUM(rng As Range) As Double
    Dim wf As WorksheetFunction, r As Range, Z As Double
    Set wf = Application.WorksheetFunction
    For Each r In rng
        Z = Z + 10 ^ (r.Value / 10)
    Next r
    DBSUM = 10 * wf.Log10(Z)
End Function

I've tried to use the switch function to adapt the first formula, but I know I'm way off. I feel like I'll have to write two seperate loops and somehow link them, but I have no idea how to do that. Below is what I have so far, so could someone tell me how wrong I am?

Public Function DBA(rng1 As Range, rng2 As Range) As Double
    Dim wf As WorksheetFunction, r1 As Range, r2 As Range, Z1 As Double, Z2 As Double
    Set wf = Application.WorksheetFunction
    
    For Each r1 In rng1
        Z1 = Z1 + Switch(r2.Value = 31.5, r1.Value - 39.4, r2.Value = 63, r1.Value - 26.2, r2.Value = 125, r1.Value - 16.1, r2.Value = 250, r1.Value - 8.6, r2.Value = 500, r1.Value - 3.2, r2.Value = 1000, r1.Value, r2.Value = 2000, r1.Value + 1.2, r2.Value = 4000, r1.Value + 1, r2.Value = 8000, r1.Value - 1.1, r2.Value = 16000, r1.Value - 6.6)
    Next r1
    For Each r2 In rng2
        Z2 = Z2 + 10 ^ (Z1 / 10)
    Next r2
    DBA = 10 * wf.Log10(Z2)
End Function

Is it supposed to be summed up or averaged? Give an example of the data and the expected result. It is best to add a link to an article with the mathematical formulas you want to use. — MGonet
– MGonet, Commented Oct 18 at 11:36

CDP1802 · Accepted Answer · 2025-10-19 07:35:34Z

2

If the ranges are A1:A10, B1:10 the use Set r2 = r1.Offset(, 1) (Note argument rng2 is not required), Otherwise use a counter with Set r2 = rng2.Cells(i,1). For example

Option Explicit

Public Function DBA(rng1 As Range, rng2 As Range) As Double
    Dim wf As WorksheetFunction, r1 As Range, r2 As Range
    Dim Z1 As Double, Z2 As Double, att As Double, i as long
    Set wf = Application.WorksheetFunction
    
    For Each r1 In rng1
        att = 0
        i = i + 1
        Set r2 = rng2.Cells(i,1)
        'Set r2 = r1.Offset(, 1)

        Select Case r2.Value
            Case 31.5: att = -39.4
            Case 63: att = -26.2
            Case 125: att = -16.1
            Case 250: att = -8.6
            Case 500: att = -3.2
            Case 1000: att = 0
            Case 2000: att = 1.2
            Case 4000: att = 1
            Case 8000: att = -1.1
            Case 16000: att = -6.6
        End Select
        Z1 = Z1 + r1.Value + att
        Z2 = Z2 + 10 ^ (Z1 / 10)
    Next
    DBA = 10 * wf.Log10(Z2)
End Function

edited Oct 19 at 7:35

answered Oct 18 at 11:50

CDP1802

17.3k2 gold badges10 silver badges19 bronze badges

Sign up to request clarification or add additional context in comments.

13 Comments

Higgy Oct 18 at 15:40

Thanks for the reply! The data is not always going to be in those cells, so I'd rather have them both defined as ranges, but it certainly looks more along the lines of what I'm trying to achieve.

CDP1802 Oct 18 at 15:49

@Higgy - see update

Higgy Oct 19 at 6:26

Thank you. It doesn't seem to be giving the results I would expect; It's giving the answer 769.6, where the answer should work out to 102.3. It seems to be doing addition of some numbers and not taking into account the logarithmic part of the equation (10*log10(10^(L1/10)+10^(L2/10) etc.)). I can't seem to figure out where in the code it's breaking.

MGonet Oct 19 at 6:51

Z1 should not be summed up: Z1 = r1.Value + att

CDP1802 Oct 19 at 7:37

@higgy I have corrected Case 125.5:

Higgy Oct 20 at 11:25

Z1=r1.Value + att made a difference and the calc now equals 102.8, but we're still 0.5/0.6 dB away from the correct answer. Again, have tried to dissect where it's going wrong but have no idea. Thanks for the help on this again!

CDP1802 Oct 20 at 15:30

@higgy Is rng1 the frequencies ie 31.5, 63. 125 etc ?

Higgy Oct 21 at 5:09

No, rng1 would be the dB level at each octave band frequency

Tim Williams Oct 20 at 18:39

Needs a Case Else for unexpected inputs from rng2 ? It's not clear from the original code if those are allowed: Switch returns Null when no test evaluates to True

|

Collectives™ on Stack Overflow

Writing a custom function with VBA to calculate dBA from linear spectral data

1 Answer 1

13 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

13 Comments

Your Answer

Sign up or log in

Post as a guest

Related