Scribd
Upload
4 views3 pages

Another Code

The document contains a VBA macro named CalculateSurvey that calculates the distance and bearing between pairs of coordinates in an Excel sheet. It checks for empty or non-numeric inputs and displays error messages if any issues are found. Upon successful completion, it outputs the calculated distance and bearing to specified cells and notifies the user of successful calculations.

Uploaded by

danielkofijnr2004
Copyright
© All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as DOCX, PDF, TXT or read online on Scribd
4 views3 pages

Another Code

The document contains a VBA macro named CalculateSurvey that calculates the distance and bearing between pairs of coordinates in an Excel sheet. It checks for empty or non-numeric inputs and displays error messages if any issues are found. Upon successful completion, it outputs the calculated distance and bearing to specified cells and notifies the user of successful calculations.

Uploaded by

danielkofijnr2004
Copyright
© All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as DOCX, PDF, TXT or read online on Scribd

Sub CalculateSurvey()

Dim I As Integer

Dim x1 As Double, y1 As Double

Dim x2 As Double, y2 As Double

Dim dx As Double, dy As Double

Dim distance As Double

Dim bearing As Double

‘ Loop through points

For I = 2 To 5

‘ Check if cells are empty

If IsEmpty(Cells(I, 2)) Or IsEmpty(Cells(I, 3)) Or _

IsEmpty(Cells(I + 1, 2)) Or IsEmpty(Cells(I + 1, 3)) Then

MsgBox “Missing coordinate at row “ & I, vbCritical

Exit Sub

End If

‘ Check if inputs are numeric

If Not IsNumeric(Cells(I, 2)) Or Not IsNumeric(Cells(I, 3)) Or _

Not IsNumeric(Cells(I + 1, 2)) Or Not IsNumeric(Cells(I + 1, 3)) Then

MsgBox “Invalid input at row “ & I & “. Enter numbers only.”, vbCritical

Exit Sub

End If
‘ Assign values

X1 = Cells(I, 2).Value

Y1 = Cells(I, 3).Value

X2 = Cells(I + 1, 2).Value

Y2 = Cells(I + 1, 3).Value

‘ Calculate differences

Dx = x2 – x1

Dy = y2 – y1

‘ Calculate distance

Distance = Sqr(dx ^ 2 + dy ^ 2)

‘ Calculate bearing

If dy = 0 Then

MsgBox “Division by zero error at row “ & I, vbCritical

Exit Sub

End If

Bearing = [Link](dx / dy) * 180 / 3.14159265358979

‘ Output results

Cells(I, 4).Value = Round(distance, 2)

Cells(I, 5).Value = Round(bearing, 2)

Next i
MsgBox “Calculations completed successfully!”, vbInformation

End Sub

You might also like