Don't Understand how inputs work on this VBA code

A

artz

Well-known Member
Joined
Aug 11, 2002
Messages
830
Office Version
  1. 2016
Platform
  1. Windows
Hi,

I am working on an electrical design project that requires the calculation of a certain value electrical component called a resistor. The exact value is not available as a standard EIA value. A next best value can be found using either a series connection of two resistors (resistors connected end to end) or two resistors connected in parallel, i.e., connected across each other, in parallel.

The only VBA program that I could find online, contained the code listed below. The inputs below call the various functions in the code to provide these calculations.

Inputs:

B7, B10, B13, B16, B19

E7, E10, E13, E16, E19


Code: 
'*****************************************************************************************
'CODE MODULE    :   MOD_RLC
'DEVELOPER      :   ALEXANDER BELL, INFOSOFT INTERNATIONAL INC (www.alexanderbell.us)
'YEAR           :   2008
'VERSION        :   1.01
'*****************************************************************************************
'**  DISCLAIMER: THIS CODE IS PROVIDED ON "AS IS" BASIS WITHOUT WARRANTY OF ANY KIND  ****
'*****************************************************************************************
Option Explicit

'<CONSTANTS> *****************************************************************************
    '<SEARCH LIMITS>
    Private Const MAX_R As Integer = 18        'R HIGH LIMIT (ORDER OF 10)
    Private Const MIN_R As Integer = -6        'R LOW LIMIT (ORDER OF 10)
    Private Const MAX_R_PREF As Integer = 8    'PREF R HIGH LIMIT (ORDER OF 10)
    Private Const MIN_R_PREF As Integer = -3   'PREF R LOW LIMIT (ORDER OF 10)
    Private Const MAX_L As Integer = 12        'L HIGH LIMIT (ORDER OF 10)
    Private Const MIN_L As Integer = -12       'L LOW LIMIT (ORDER OF 10)
    Private Const MAX_L_PREF As Integer = 3    'PREF L HIGH LIMIT (ORDER OF 10)
    Private Const MIN_L_PREF As Integer = -7   'PREF L LOW LIMIT (ORDER OF 10)
    Private Const MAX_C As Integer = 6         'C HIGH LIMIT (ORDER OF 10)
    Private Const MIN_C As Integer = -20       'C LOW LIMIT (ORDER OF 10)
    Private Const MAX_C_PREF As Integer = 3    'PREF C HIGH LIMIT (ORDER OF 10)
    Private Const MIN_C_PREF As Integer = -15  'PREF C LOW LIMIT (ORDER OF 10)
    '</SEARCH LIMITS>
    
    '<ERROR CODES>
    Private Const ERR_1 As String = "VALUE SHOULD BE NUMERIC"
    Private Const ERR_2 As String = "VALUE IS TOO SMALL"
    Private Const ERR_4 As String = "VALUE IS TOO BIG"
    Private Const ERR_8 As String = "LOW LIMIT SHOULD BE NUMERIC"
    Private Const ERR_16 As String = "HIGH LIMIT SHOULD BE NUMERIC"
    Private Const ERR_32 As String = "ERROR IN ValidateNumeric FUNCTION"
    Private Const ERR_1024 As String = "COMPONENT TYPE SHOULD BE R,L,C or EMPTY"
    Private Const ERR_2048 As String = "SPECIFY E-SERIES"
    Private Const ERR_4096 As String = "CONNECTION SHOULD BE SERIES OR PARALLEL"
    Private Const ERR_GEN As String = "UNANTICIPATED ERROR"
    Private Const ERR_GEN_CODE As Long = 65536 'GENERAL ERROR
    '</ERROR CODES>
'</CONSTANTS> ****************************************************************************


'*****************************************************************************************
'<MAIN FUNCTIONS>
'*****************************************************************************************

'*****************************************************************************************
'USAGE :    FIND THE BEST FIT FOR GIVEN R USING TWO-COMPONENT TOPOLOGY (PAR OR SER)
'           IF ExtSearch SET TO TRUE APPLY EXTENDED VALUE RANGE (MAX_R/MIN_R)
'           IF ExtSearch SET TO FALSE APPLY PREFERED VALUE RANGE (MAX_R_PREF/MIN_R_PREF)
'*****************************************************************************************
Public Function FitR(ByVal R As Double, _
                ByVal ParSer As String, _
                Optional ByVal ESeries As String = "E24", _
                Optional ByVal ExtSearch As Boolean = False) As String

On Error GoTo ErrorHandle
    Dim R1 As Double        'RESISTOR VALUE
    Dim R2 As Double        'RESISTOR VALUE
    Dim RelError As Double  'REL ERROR OF APPROXIMATION
    Dim ErrorCode As Long   'ERROR CODE
    Dim intLow As Integer   'LOW LIMIT (ORDER OF 10)
    Dim intHigh As Integer  'HIGH LIMIT (ORDER OF 10)

'SET HIGH-LOW SEARCH LIMITS (ORDER OF 10)
If ExtSearch Then
    intHigh = MAX_R - 1
    intLow = MIN_R
Else
    intHigh = MAX_R_PREF - 1
    intLow = MIN_R_PREF
End If

'** DATA VALIDATION **************************************************
ErrorCode = ErrorCode Or ValidateNumeric(R, 10 ^ intLow, 10 ^ intHigh)
ErrorCode = ErrorCode Or ValidateE(ESeries)
ErrorCode = ErrorCode Or ValidateParSer(ParSer)
If ErrorCode Then GoTo ErrorHandle

If Not FindRLC(R, intLow, intHigh, ParSer, ESeries, R1, R2, RelError) Then
    ErrorCode = ErrorCode Or ERR_GEN_CODE
End If
If ErrorCode Then GoTo ErrorHandle

'OUTPUT STRING
FitR = "R1=" & E2BOM(R1, "Ohm") & ", "
FitR = FitR & "R2=" & E2BOM(R2, "Ohm") & ", "
FitR = FitR & "Err=" & Format(RelError, "0.000000%")

Exit Function
ErrorHandle:
    FitR = "Error Code = " & ErrorCode
End Function

'*****************************************************************************************
'USAGE :    FIND THE BEST FIT FOR GIVEN L USING TWO-COMPONENT TOPOLOGY (PAR OR SER)
'           IF ExtSearch SET TO TRUE APPLY EXTENDED VALUE RANGE (MAX_L/MIN_L)
'           IF ExtSearch SET TO FALSE APPLY PREFERED VALUE RANGE (MAX_L_PREF/MIN_L_PREF)
'*****************************************************************************************
Public Function FitL(ByVal L As Double, _
                ByVal ParSer As String, _
                Optional ByVal ESeries As String = "E24", _
                Optional ByVal ExtSearch As Boolean = False) As String

On Error GoTo ErrorHandle
    Dim L1 As Double            '** INDUCTANCE
    Dim L2 As Double            '** INDUCTANCE
    Dim RelError As Double      '** RELATIVE ERROR OF APPROXIMATION
    Dim ErrorCode As Long       '** ERROR CODE
    Dim intLow As Integer       '** LOW LIMIT (ORDER OF 10)
    Dim intHigh As Integer      '** HIGH LIMIT (ORDER OF 10)

'SET HIGH-LOW SEARCH LIMITS (ORDER OF 10)
If ExtSearch Then
    intHigh = MAX_L - 1
    intLow = MIN_L
Else
    intHigh = MAX_L_PREF - 1
    intLow = MIN_L_PREF
End If

'** DATA VALIDATION WITH VOICE FEEDBACK **************************************************
ErrorCode = ErrorCode Or ValidateNumeric(L, 10 ^ intLow, 10 ^ intHigh)
ErrorCode = ErrorCode Or ValidateE(ESeries)
ErrorCode = ErrorCode Or ValidateParSer(ParSer)
If ErrorCode Then GoTo ErrorHandle

If Not FindRLC(L, intLow, intHigh, ParSer, ESeries, L1, L2, RelError) Then
    ErrorCode = ErrorCode Or ERR_GEN_CODE
End If

If ErrorCode Then GoTo ErrorHandle

FitL = "L1=" & E2BOM(L1, "H") & ", "
FitL = FitL & "L2=" & E2BOM(L2, "H") & ", "
FitL = FitL & "Err=" & Format(RelError, "0.000000%")

Exit Function
ErrorHandle:
    FitL = "Error Code = " & ErrorCode
End Function

'USAGE :    FIND THE BEST FIT FOR GIVEN C USING TWO-COMPONENT TOPOLOGY (PAR OR SER)
'           IF ExtSearch SET TO TRUE APPLY EXTENDED VALUE RANGE (MAX_C/MIN_C)
'           IF ExtSearch SET TO FALSE APPLY PREFERED VALUE RANGE (MAX_C_PREF/MIN_C_PREF)
'*****************************************************************************************
Public Function FitC(ByVal C As Double, _
                ByVal ParSer As String, _
                Optional ByVal ESeries As String = "E24", _
                Optional ByVal ExtSearch As Boolean = False) As String
On Error GoTo ErrorHandle
    Dim C1 As Double        'CAPACITANCE
    Dim C2 As Double        'CAPACITANCE
    Dim RelError As Double  'REL ERROR OF APPROXIMATION
    Dim ErrorCode As Long   'ERROR CODE
    Dim intLow As Integer   'LOW LIMIT (ORDER OF 10)
    Dim intHigh As Integer  'HIGH LIMIT (ORDER OF 10)
    Dim strPS As String     '"P" or "S" - INVERSE TO RL

'SET HIGH-LOW LIMITS (ORDER OF 10)
If ExtSearch Then
    intHigh = MAX_C - 1:     intLow = MIN_C
Else
    intHigh = MAX_C_PREF - 1:    intLow = MIN_C_PREF
End If

'** DATA VALIDATION **************************************************
ErrorCode = ErrorCode Or ValidateNumeric(C, 10 ^ intLow, 10 ^ intHigh)
ErrorCode = ErrorCode Or ValidateE(ESeries)
ErrorCode = ErrorCode Or ValidateParSer(ParSer)

'USE THE OPPOSITE TOPOLOGY CALCULATIONS (COMPARING TO RL)
Select Case ParSer
Case "Serial", "serial", "Series", "series", "SER", "Ser", "ser", "S", "s"
    strPS = "P"
Case "Parallel", "parallel", "PAR", "Par", "par", "P", "p"
    strPS = "S"
Case Else
   ErrorCode = ErrorCode Or 2048
End Select
If ErrorCode Then GoTo ErrorHandle

If Not FindRLC(C, intLow, intHigh, strPS, ESeries, C1, C2, RelError) Then
    ErrorCode = ErrorCode Or ERR_GEN_CODE
End If
If ErrorCode Then GoTo ErrorHandle

'OUTPUT STRING
FitC = "C1=" & E2BOM(C1, "F") & ", "
FitC = FitC & "C2=" & E2BOM(C2, "F") & ", "
FitC = FitC & "Err=" & Format(RelError, "0.000000%")

Exit Function
ErrorHandle:
    FitC = "Error Code = " & ErrorCode
End Function
'*****************************************************************************************
'</MAIN FUNCTIONS>
'*****************************************************************************************


'*****************************************************************************************
'<AUX FUNCTIONS>
'*****************************************************************************************

'*****************************************************************************************
'LOOP THROUGH E-SERIES ARRAY TO FIND R2 AND R1 MANTISSA RESULTING IN A MIN ABS ERROR
'*****************************************************************************************
Private Function FindRLC(ByVal R As Double, _
                ByVal intLow As Integer, _
                ByVal intHigh As Integer, _
                ByVal ParSer As String, _
                ByVal ESeries As String, _
                ByRef R1 As Double, _
                ByRef R2 As Double, _
                ByRef dblError As Double) As Boolean
On Error GoTo ErrorHandle
    Dim I As Integer, J As Integer  'LOOP COUNTERS
    Dim K As Integer, L As Integer  'LOOP COUNTERS
    Dim arrR As Variant             'VALUE ARRAY
    Dim dblMantissa As Double       'MANTISSA VARIABLE
    Dim intOrder As Integer         'ORDER VARIABLE
    Dim Ord1 As Double, Ord2 As Double
    Dim TempR1 As Double, TempR2 As Double

arrR = StdRLC(ESeries)
If Not IsArray(arrR) Then GoTo ErrorHandle

'** CALCULATE ORDER AND MANTISSA FOR GIVEN R
intOrder = Int(Log(R) / Log(10)) '**************
dblMantissa = R / (10 ^ intOrder)

Select Case ParSer

'PARALLEL R CONNECTION
Case "Parallel", "parallel", "PAR", "Par", "par", "P", "p"

    R1 = FitE(dblMantissa * 2) * 10 ^ intOrder
    R2 = R1: dblError = Abs(R1 * R2 / (R1 + R2) - R)
    
    For K = intOrder To intHigh
        Ord1 = 10 ^ K
        For I = LBound(arrR) To UBound(arrR)
            TempR1 = arrR(I) * Ord1
            For L = intOrder To intHigh
                Ord2 = 10 ^ L
                For J = LBound(arrR) To UBound(arrR)
                    TempR2 = arrR(J) * Ord2
                    If Abs(TempR1 * TempR2 / (TempR1 + TempR2) - R) < dblError Then
                        R1 = TempR1: R2 = TempR2
                        dblError = Abs(R1 * R2 / (R1 + R2) - R)
                    End If
                    If dblError = 0 Then Exit For
                Next J
                If dblError = 0 Then Exit For
            Next L
            If dblError = 0 Then Exit For
        Next I
        If dblError = 0 Then Exit For
    Next K
    dblError = (R1 * R2 / (R1 + R2) - R) / R

'SERIAL R CONNECTION
Case "Serial", "serial", "Series", "series", "SER", "Ser", "ser", "S", "s"

    R1 = FitE(dblMantissa * 0.5) * 10 ^ intOrder
    R2 = R1: dblError = Abs(R1 + R2 - R)
    
    For K = intLow To intOrder
        Ord1 = 10 ^ K
        For I = LBound(arrR) To UBound(arrR)
            TempR1 = arrR(I) * Ord1
            For L = intLow To intOrder
                Ord2 = 10 ^ L
                For J = LBound(arrR) To UBound(arrR)
                    TempR2 = arrR(J) * Ord2
                    If Abs(TempR1 + TempR2 - R) < dblError Then
                        R1 = TempR1: R2 = TempR2
                        dblError = Abs(TempR1 + TempR2 - R)
                    End If
                    If dblError = 0 Then Exit For
                Next J
                If dblError = 0 Then Exit For
            Next L
            If dblError = 0 Then Exit For
        Next I
        If dblError = 0 Then Exit For
    Next K
    dblError = (R1 + R2) / R - 1
    
Case Else
    GoTo ErrorHandle
End Select
    FindRLC = True

Exit Function
ErrorHandle:
    R1 = Null: R2 = Null: dblError = Null
    FindRLC = False
End Function

'*****************************************************************************************
'LOOP THROUGH E-SERIES TO FIND R1 CLOSEST TO THE TARGET VALUE: (SPEED OPTIMIZATION)
'*****************************************************************************************
Private Function FitE(ByVal RLC As Double, Optional ByVal ESeries As String = "E24") _
As Double

On Error GoTo ErrorHandle
    Dim RE As Double                    'RESISTOR VALUE
    Dim dblError As Double              'ERROR OF APPROXIMATION
    Dim I As Integer                    'LOOP COUNTERS
    Dim dblMantissa As Double           'MANTISSA
    Dim intOrder As Integer             'ORDER
    Dim arrR As Variant                 'E-SERIES VALUE ARRAY
    Dim ErrorCode As Long               'ERROR CODE
    
'** DATA VALIDATION **************************************************
ErrorCode = ErrorCode Or ValidateNumeric(RLC)
ErrorCode = ErrorCode Or ValidateE(ESeries)
If ErrorCode Then GoTo ErrorHandle

arrR = StdRLC(ESeries)
If Not IsArray(arrR) Then
    ErrorCode = ERR_GEN
    GoTo ErrorHandle
End If

'** CALCULATE ORDER AND MANTISSA FOR GIVEN R
intOrder = Int(Log(RLC) / Log(10)) '**************
dblMantissa = RLC / (10 ^ intOrder)

RE = 1: dblError = Abs(RE - dblMantissa)
For I = LBound(arrR) To UBound(arrR)
    If Abs(arrR(I) - dblMantissa) < dblError Then
        RE = arrR(I)
        dblError = Abs(arrR(I) - dblMantissa)
    End If
    If dblError = 0 Then Exit For
Next I
FitE = RE * 10 ^ intOrder

Exit Function
ErrorHandle:
    FitE = 0
End Function
'*****************************************************************************************

'*****************************************************************************************
'VALIDATE VALUES
'*****************************************************************************************
Private Function ValidateNumeric(ByVal varRLC As Variant, _
                    Optional ByVal MinRLC As Variant, _
                    Optional ByVal MaxRLC As Variant, _
                    Optional ByVal TypeRLC As Variant) As Long
On Error GoTo ErrorHandle
    Dim boolValidateMin As Boolean
    Dim boolValidateMax As Boolean
    Dim dblRLC As Double

'** IS NUMERIC **************************************************
If Not IsNumeric(varRLC) Then
    ValidateNumeric = 1
    Exit Function
End If

If Not (IsMissing(MinRLC)) Then
    If Not IsNumeric(MinRLC) Then
        ValidateNumeric = 8
        Exit Function
    End If
    boolValidateMin = True
End If

If Not (IsMissing(MaxRLC)) Then
    If Not IsNumeric(MaxRLC) Then
        ValidateNumeric = 16
        Exit Function
    End If
    boolValidateMax = True
End If

dblRLC = CDbl(varRLC)

'** CHECK THE RANGE ********************************************
If boolValidateMin Then
    If dblRLC < CDbl(MinRLC) Then
        ValidateNumeric = 2
        Exit Function
    End If
End If

If boolValidateMax Then
    If dblRLC > CDbl(MaxRLC) Then
        ValidateNumeric = 4
        Exit Function
    End If
End If

'** VALIDATION OK ********************************************
ValidateNumeric = 0
Exit Function

ErrorHandle:
    ValidateNumeric = 32
End Function

'*****************************************************************************************
'VALIDATE RLC SYNTAX
'*****************************************************************************************
Private Function ValidateRLC(ByVal varRLC As Variant) As Long
On Error GoTo ErrorHandle

Select Case varRLC
Case "R", "r", "L", "l", "C", "c", ""
    ValidateRLC = 0
Case Else
    GoTo ErrorHandle
End Select

Exit Function
ErrorHandle:
  ValidateRLC = 1024
End Function

'*****************************************************************************************
'VALIDATE E-SERIES SYNTAX
'*****************************************************************************************
Private Function ValidateE(ByVal varE As Variant) As Long
On Error GoTo ErrorHandle

Select Case varE
Case "E192", "E96", "E48", "E24", "E12", "E6", _
      "e192", "e96", "e48", "e24", "e12", "e6", ""
    ValidateE = 0
Case Else
    GoTo ErrorHandle
End Select

Exit Function
ErrorHandle:
    ValidateE = 2048
End Function

'*****************************************************************************************
'VALIDATE TOPOLOGY SYNTAX (PAR/SER)
'*****************************************************************************************
Private Function ValidateParSer(ByVal varParSer As Variant) As Long
On Error GoTo ErrorHandle

Select Case varParSer
Case "Serial", "serial", "Series", "series", "SER", "Ser", "ser", "S", "s"
    ValidateParSer = 0
Case "Parallel", "parallel", "PAR", "Par", "par", "P", "p"
    ValidateParSer = 0
Case Else
    GoTo ErrorHandle
End Select

Exit Function
ErrorHandle:
    ValidateParSer = 4096
End Function

'*****************************************************************************************
'SCIENTIFIC-TO-ENGINEERING FORMAT CONVERSION
'*****************************************************************************************
Private Function E2BOM(ByVal dblRLC As Double, Optional varUnit As Variant) As String
    On Error GoTo ErrorHandle
    Dim intOrder As Integer
    Dim dblMantissa As Double

If dblRLC >= 1 Then
    intOrder = Int(Log(dblRLC * 1.00001) / Log(10))
Else
    intOrder = Fix(Log(dblRLC) / Log(10))
End If

Select Case intOrder

    Case Is >= 12
        E2BOM = CStr(dblRLC / 1000000000000#) & " T"
    Case Is >= 9
        E2BOM = CStr(dblRLC / 1000000000#) & " G"
    Case Is >= 6
       E2BOM = CStr(dblRLC / 1000000#) & " M"
    Case Is >= 3
        E2BOM = CStr(dblRLC / 1000#) & " k"
    Case Is >= 0
        E2BOM = CStr(dblRLC) & " "
    Case Is >= -3
        E2BOM = CStr(dblRLC * 1000) & " m"
    Case Is >= -6
        E2BOM = CStr(dblRLC * 1000000) & " u"
    Case Is >= -9
        E2BOM = CStr(dblRLC * 1000000000) & " n"
    Case Else
        E2BOM = CStr(dblRLC * 1000000000000#) & " p"
    
End Select

If Not (IsMissing(varUnit)) Then
    E2BOM = E2BOM & CStr(varUnit)
End If

Exit Function
ErrorHandle:
    E2BOM = ""
End Function


'*****************************************************************************************
'STANDARD E-SERIES (DEFAULT E24)
'*****************************************************************************************
Private Function StdRLC(Optional ByVal strSeries As String = "E24") As Variant
On Error GoTo ErrorHandle

Select Case strSeries
Case "E192", "e192"

StdRLC = Array(1#, 1.01, 1.02, 1.04, 1.05, 1.06, 1.07, 1.09, 1.1, 1.11, 1.13, 1.14, _
            1.15, 1.17, 1.18, 1.2, 1.21, 1.23, 1.24, 1.26, 1.27, 1.29, 1.3, 1.32, _
            1.33, 1.35, 1.37, 1.38, 1.4, 1.42, 1.43, 1.45, 1.47, 1.49, 1.5, 1.52, _
            1.54, 1.56, 1.58, 1.6, 1.62, 1.64, 1.65, 1.67, 1.69, 1.72, 1.74, 1.76, _
            1.78, 1.8, 1.82, 1.84, 1.87, 1.89, 1.91, 1.93, 1.96, 1.98, 2#, 2.03, _
            2.05, 2.08, 2.1, 2.13, 2.15, 2.18, 2.21, 2.23, 2.26, 2.29, 2.32, 2.34, _
            2.37, 2.4, 2.43, 2.46, 2.49, 2.52, 2.55, 2.58, 2.61, 2.64, 2.67, 2.71, _
            2.74, 2.77, 2.8, 2.84, 2.87, 2.91, 2.94, 2.98, 3.01, 3.05, 3.09, 3.12, _
            3.16, 3.2, 3.24, 3.28, 3.32, 3.36, 3.4, 3.44, 3.48, 3.52, 3.57, 3.61, _
            3.65, 3.7, 3.74, 3.79, 3.83, 3.88, 3.92, 3.97, 4.02, 4.07, 4.12, 4.17, _
            4.22, 4.27, 4.32, 4.37, 4.42, 4.48, 4.53, 4.59, 4.64, 4.7, 4.75, 4.81, _
            4.87, 4.93, 4.99, 5.05, 5.11, 5.17, 5.23, 5.3, 5.36, 5.42, 5.49, 5.56, _
            5.62, 5.69, 5.76, 5.83, 5.9, 5.97, 6.04, 6.12, 6.19, 6.26, 6.34, 6.42, _
            6.49, 6.57, 6.65, 6.73, 6.81, 6.9, 6.98, 7.06, 7.15, 7.23, 7.32, 7.41, _
            7.5, 7.59, 7.68, 7.77, 7.87, 7.96, 8.06, 8.16, 8.25, 8.35, 8.45, 8.56, _
            8.66, 8.76, 8.87, 8.98, 9.09, 9.19, 9.31, 9.42, 9.53, 9.65, 9.76, 9.88)

Case "E96", "e96"
StdRLC = Array(1#, 1.02, 1.05, 1.07, 1.1, 1.13, 1.15, 1.18, 1.21, 1.24, 1.27, 1.3, _
                1.33, 1.37, 1.4, 1.43, 1.47, 1.5, 1.54, 1.58, 1.62, 1.65, 1.69, 1.74, _
                1.78, 1.82, 1.87, 1.91, 1.96, 2#, 2.05, 2.1, 2.15, 2.21, 2.26, 2.32, _
                2.37, 2.43, 2.49, 2.55, 2.61, 2.67, 2.74, 2.8, 2.87, 2.94, 3.01, 3.09, _
                3.16, 3.24, 3.32, 3.4, 3.48, 3.57, 3.65, 3.74, 3.83, 3.92, 4.02, 4.12, _
                4.22, 4.32, 4.42, 4.53, 4.64, 4.75, 4.87, 4.99, 5.11, 5.23, 5.36, 5.49, _
                5.62, 5.76, 5.9, 6.04, 6.19, 6.34, 6.49, 6.65, 6.81, 6.98, 7.15, 7.32, _
                7.5, 7.68, 7.87, 8.06, 8.25, 8.45, 8.66, 8.87, 9.09, 9.31, 9.53, 9.76)

Case "E48", "e48"
StdRLC = Array(1#, 1.05, 1.1, 1.15, 1.21, 1.27, 1.33, 1.4, 1.47, 1.54, 1.62, 1.69, _
                1.78, 1.87, 1.96, 2.05, 2.15, 2.26, 2.37, 2.49, 2.61, 2.74, 2.87, 3.01, _
                3.16, 3.32, 3.48, 3.65, 3.83, 4.02, 4.22, 4.42, 4.64, 4.87, 5.11, 5.36, _
                5.62, 5.9, 6.19, 6.49, 6.81, 7.15, 7.5, 7.87, 8.25, 8.66, 9.09, 9.53)

' Note: Corrected on 11/15/08 (AB)
Case "E24", "e24"
   StdRLC = Array(1#, 1.1, 1.2, 1.3, 1.5, 1.6, 1.8, 2#, 2.2, 2.4, 2.7, 3#, _
                  3.3, 3.6, 3.9, 4.3, 4.7, 5.1, 5.6, 6.2, 6.8, 7.5, 8.2, 9.1)
Case "E12", "e12"
    StdRLC = Array(1#, 1.2, 1.5, 1.8, 2.2, 2.7, 3.3, 3.9, 4.7, 5.6, 6.8, 8.2)
    
Case "E6", "e6"
    StdRLC = Array(1#, 1.5, 2.2, 3.3, 4.7, 6.8)

Case Else
End Select

Exit Function
ErrorHandle:
    StdRLC = ""
End Function
'*****************************************************************************************

'*****************************************************************************************
'</AUX FUNCTIONS>
'*****************************************************************************************

In all this code, the outputs are easy, the use the funtion fit() something placed in a cell of choice. Maybe I'm missing something easy, but I don't see don't from the code see how the input cells in the worksheet are connected to the code.

If someone in the Forum could provide the linkage that I'm missing, that would be really helpful.

Thanks,

Art
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
Sort by date Sort by votes
Hello artz,

You did not miss anything. There are no references to the input cells in the code. This code calculates quite a few different "resistances", i.e. not just pure resistance but also capacitive and inductive reactance. What do you need to calculate exactly?
 
Upvote 0
Hi Leith,

For this application, I only need resistances, not capacitive and inductive reactances. Maybe I will at some point, but not now. This code works fine for my purpose now, but I don't see how to enter a value to be optimized for in any particular cell.

I want to pull this code into another workbook and need the flexibility to place the input value in any cell that i chose. What I am calculating is a parallel combination of two resistors that is closest to a desired value in another worksheet where my returned calculation is not a standard EIA resistor value, hence the parallel values.

If I can see how to setup the input cells, likely I can figure out the rest. (maybe :))

Any chance that you have a way to do this?

Thanks,

Art
 
Upvote 0
Hello atrz,

These macros could work on any set of given cells. Did you download this workbook with this code in it? I am asking because how do you know the cells you listed are in fact input cells?
 
Upvote 0
Hi Leith,

Yes, I did download the entire worksheet. I see the cells where I inputting data to, but I looked and searched but see no corresponding code as to how the inputs are implemented. Quite puzzling. I expected a cell call or RC call, but there is nothing in the code. It is the only code module in the workbook. The Sheet module is blank. Any thoughts?

Thanks,

Art
 
Upvote 0
Hello artz,

That is strange. Can you post where you got the download? I would like to see a copy for myself.
 
Upvote 0
Hello Art,

These VBA macro are known as UDFs or User Defined Functions. These macros can be used just like an Excel formula on the worksheet.

The UDF calls are in cells F7, F10, F13, F16, and F19. These reference cells E7, E10, E13, E16, and E19 as input cells.
 
Last edited:
Upvote 0
Hi Leith,

Thanks for your response and comments. The original website where I found the file on was a DIY site with no explanation. The EDN.com site hosting the original article that I sent to you explains more. I've never used a UDF and will try it out in my worksheet. If I use Ctrl ~, I can see all the links.

I will let you know if I have any issues integrating this UDF into my worksheet.

Many thanks,

Art
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Solved
Chart point must move to point of click in chart
Replies
2
Views
71
tigger_na
T
Jaafar Tribak
  • Question
Blurring images using Direct2D & Windows Imaging Component
Replies
3
Views
255
Dan_W
D
Agnarr
  • Question
VBA problem with creating new sheets
Replies
0
Views
345
Agnarr
Agnarr
A
  • Solved
Calendar form cancel button passing data to worksheet
Replies
7
Views
397
AndyEd
A
Saher Naji
  • Question
VBA Code Issue on Mac Platform (working perfectly on Windows)
Replies
4
Views
292
Cristian Buse
C

Forum statistics

Threads
1,214,927
Messages
6,122,309
Members
449,080
Latest member
jmsotelo

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top