Creating a function in excel VBA to calculate the average point in a circular set of numbers

0 votes

Please be patient with me; I'm still really new at this. In order to calculate the average of a set of values, I am trying to write a function. The group of numerals is actually a cog's teeth. Damage or stoppage is noted on teeth in a clockwise rotation, so damage at teeth 7 and 23 would be at 7 and 23 teeth from the starting tooth. The primary tooth is usually tooth 1 (identified as painted). When you calculate a normal average, there is an anomaly because the average stoppage at teeth 3, 4, and 33 would actually be 1, NOT 14.33 as per a regular average.I did the math to determine the average, and by average I mean a set of circular numbers that is closer to the median. I increase each value in the range by one and then use the MOD function to determine the difference between the highest and lowest values. It only takes a few steps to deduct the incremented number from the new average once I've determined the starting position of the shortest difference. Most likely, a table would describe it better.

image

As you can see, tooth 1, which is the average less the increment of the first group of numbers with the least difference, is the true average or median. The code I now use to run through and perform these calculations is returning a value# error, but I have very little expertise with custom functions and don't know where to begin to fix the problem. Any pointers would be greatly appreciated, and a solution would be excellent. 

Public Function AVGDISTCALC(rng As Range)
'Determines the average distance of a number of distances on a 37 tooth wheel.
Dim x As Integer
Dim i As Integer
Dim avg As Integer
Dim diff As Integer
Dim Arr() As Variant
Dim r As Long
Dim c As Long
Application.ScreenUpdating = False

    'Write the range to an array.
    Arr = rng
    'Cycle through each increment on the 37 tooth wheel.
    diff = 38
    For i = 1 To 37
    Arr = rng
        'For each increment calculate the min and max of the range.
        For r = 1 To UBound(Arr, 1)
            For c = 1 To UBound(Arr, 2)
                If (Arr(r, c) + i) Mod 37 = 0 Then
                    Arr(r, c) = 37
                Else
                    Arr(r, c) = (Arr(r, c) + i) Mod 37
                End If
            Next c
        Next r
        If WorksheetFunction.Max(Arr) - WorksheetFunction.Min(Arr) < diff Then
            diff = WorksheetFunction.Max(Arr) - WorksheetFunction.Min(Arr)
            avg = WorksheetFunction.Average(Arr)
            x = i
        End If
    Next i
    
    AVGDISTCALC = avg - x
    
End Function
Oct 28, 2022 in Others by Kithuzzz
• 38,000 points
1,158 views

1 answer to this question.

0 votes

I used the following code to determine the average of a circular group of numbers. I hope that anyone else who is having a similar problem can use this example. Simply adjust the MOD value as necessary if you require a different number of cog teeth.

Public Function AVGDISTCALC(rng As Range)
'Determines the average distance of a number of distances on a 37 tooth wheel.
Dim x As Integer
Dim i As Integer
Dim avg As Integer
Dim diff As Integer
Dim Arr() As Variant
Dim r As Long
Dim c As Long
Application.ScreenUpdating = False

    'Write the range to an array.
    Arr = rng
    'Cycle through each increment on the 37 tooth wheel.
    diff = 38
    For i = 1 To 37
    Arr = rng
        'For each increment calculate the min and max of the range.
        For r = 1 To UBound(Arr, 1)
            For c = 1 To UBound(Arr, 2)
                If (Arr(r, c) + i) Mod 37 = 0 Then
                    Arr(r, c) = 37
                Else
                    Arr(r, c) = (Arr(r, c) + i) Mod 37
                End If
            Next c
        Next r
        If WorksheetFunction.Max(Arr) - WorksheetFunction.Min(Arr) < diff Then
            diff = WorksheetFunction.Max(Arr) - WorksheetFunction.Min(Arr)
            avg = WorksheetFunction.Average(Arr)
            x = i
        End If
    Next i
    
    Select Case avg - x
    Case 0
        AVGDISTCALC = 37
    Case Is > 0
        AVGDISTCALC = avg - x
    Case Is < 0
        AVGDISTCALC = (avg - x) + 37
    End Select
    
End Function
answered Oct 28, 2022 by narikkadan
• 63,600 points

Related Questions In Others

0 votes
1 answer
0 votes
1 answer

How to programmatically get the values of a spilled Excel range in VBA?

By using the Text property, I was ...READ MORE

answered Mar 23, 2023 in Others by narikkadan
• 63,600 points
1,292 views
0 votes
1 answer

VBA how to calculate depth of items in excel, simliar to a BOM system

Add on the sheet an ActiveX Microsoft ...READ MORE

answered Mar 24, 2023 in Others by Kithuzzz
• 38,000 points
642 views
0 votes
1 answer

Is there a function in excel to automatically calculate age using date of birth?

Try  =INT((YEARFRAC(TODAY(),B3,1)))  Where cell B3 contains a date like ...READ MORE

answered Mar 28, 2023 in Others by Kithuzzz
• 38,000 points
629 views
0 votes
1 answer

Retrieve epay.info Balance with VBA and Excel

This code should log you in, provided ...READ MORE

answered Sep 5, 2018 in Blockchain by digger
• 26,740 points
1,259 views
0 votes
1 answer

How to load file to Excel Power query from SFTP site

Currently, I don't think there is a ...READ MORE

answered Dec 3, 2018 in Power BI by Upasana
• 8,620 points
3,697 views
0 votes
1 answer

Using VBA Excel to create a gramatically correct list

The Excel AND function is a logical ...READ MORE

answered Feb 9, 2022 in Others by gaurav
• 23,260 points
974 views
0 votes
2 answers

How to copy a formula horizontally within a table using Excel VBA?

Hi so basically, create an adjacent column ...READ MORE

answered Feb 16, 2022 in Others by Edureka
• 13,690 points
1,089 views
0 votes
1 answer

How can I use a command button in excel to set the value of multiple cells in one click?

Try this: Private Scan As Integer Private Sub CommandButton1_Click() ...READ MORE

answered Oct 24, 2022 in Others by narikkadan
• 63,600 points
797 views
0 votes
1 answer

How do I use the Indirect Function in Excel VBA to incorporate the equations in a VBA Macro Function

Try this: Sub Test() Dim str As String: str ...READ MORE

answered Jan 19, 2023 in Others by narikkadan
• 63,600 points
1,060 views
webinar REGISTER FOR FREE WEBINAR X
REGISTER NOW
webinar_success Thank you for registering Join Edureka Meetup community for 100+ Free Webinars each month JOIN MEETUP GROUP