How to use VBA to incorporate functions to avoid occupation of extra cells?

Rabbiiiiit 0
Viewed 42

This spreadsheet aims to calculate distances between atoms, and we want to improve the functions so as to avoid the occupation of extra columns. (See image postscripted.Atom coordinates are given in the Column A to D, and the atom pair whose distance should be calculated is given in Column F to G. Atom coordinates are given in the Column A to D, and the atom pair whose distance should be calculated is given in Column F to G.)

Currently in the first step, coordinates of specified atoms are picked up in columns I to O. e.g. Cell I4 is filled with the function:

=VLOOKUP($F4,$A$4:$E$1023,2,FALSE)

and then in the next step, the distance could be resolved in Column Q with Euclidean distance formula on the coordinates picked up. e.g. Cell Q4 is:

=SQRT(POWER((I4-M4),2)+POWER((J4-N4),2)+POWER((K4-O4),2))

According to the distance calculating algorithm, once the two atoms are specified, the distance is then determined. Thus, is it possible to write a function with VBA to gracefully incorporate these functions and take away these pilot processes from columns I to O? (Because these columns will be used otherwise in the future; and the code readability would be terrible if we put, for example, the six VLOOKUP functions directly into the final SQRT function.)

I'm new to VBA. Any help would be appreciated. Thanks!

vba excel
1 Answers

Finally, these two modules will work. (Although the quality of this code is not high. )

Function CoordinateVLookUp(Atom_No As Integer, CoordinateTableRange As Range, Column As Integer, isFuzzy As Boolean) As Double

    Dim myResult As Variant
    myResult = Application.WorksheetFunction.VLookup(Atom_No, CoordinateTableRange, Column, isFuzzy)
    If IsError(myResult) Then
        MsgBox ("No result found.")
    Else
        CoordinateVLookUp = myResult
    End If

End Function

Function AtomsDistance(Atom_No1 As Integer, Atom_No2 As Integer) As Double
    
    Dim x1 As Double
    Dim y1 As Double
    Dim z1 As Double

    Dim x2 As Double
    Dim y2 As Double
    Dim z2 As Double
    
    Dim CoordinateTableRange As Range
    Set CoordinateTableRange = Range("A4:E1023") 'set should be added
            
    x1 = CoordinateVLookUp(Atom_No1, CoordinateTableRange, 2, False)
    y1 = CoordinateVLookUp(Atom_No1, CoordinateTableRange, 3, False)
    z1 = CoordinateVLookUp(Atom_No1, CoordinateTableRange, 4, False)
    
    x2 = CoordinateVLookUp(Atom_No2, CoordinateTableRange, 2, False)
    y2 = CoordinateVLookUp(Atom_No2, CoordinateTableRange, 3, False)
    z2 = CoordinateVLookUp(Atom_No2, CoordinateTableRange, 4, False)
    
    AtomsDistance = Math.Sqr((x1 - x2) * (x1 - x2) + (y1 - y2) * (y1 - y2) + (z1 - z2) * (z1 - z2))
    
End Function
Rabbiiiiit0
Related