This is not homework. This is code that I had written years ago when I was not used to structured programming. I was going to do this myself but thought someone could get points and I may do something else.

Are you competent to do this or are you just trying to enjoy?

0

There are many ways to learn to code these days. From coding bootcamps like Flatiron School to online courses to totally free beginner resources. The best way to learn to code depends on many factors, but the most important one is you. See what course is best for you.

Putting a comment on a question sends it into low priority and attracts less experts. So unless you are contributing positively to the question or have a good point to make you should not start responding. That was why I was a bit matter-of-factly.

Alex, if you had looked to the right of the screen you would notice the Hall of Fame.

ssaqibh is regularly in the top 10 so I don't think he would be posting a question on here for homework; overloaded with work so making the most of other's expertise, maybe!

It seems too late now, but here is my attempt (& an attached workbook that demonstrates that the original code & the re-written code produce the same results):

Option ExplicitPublic Function lngF(ByVal xi As Double, _ ByVal x1 As Double, _ ByVal x2 As Double, _ ByVal x3 As Double, _ ByVal x4 As Double, _ ByVal yi As Double, _ ByVal y1 As Double, _ ByVal y2 As Double, _ ByVal y3 As Double, _ ByVal y4 As Double) As Long Dim F As LongIf Abs(xi - x1) < Abs(0.00001 * xi) And Abs(yi - y1) < Abs(0.00001 * yi) Then GoTo 10If Abs(xi - x2) < Abs(0.00001 * xi) And Abs(yi - y2) < Abs(0.00001 * yi) Then GoTo 10If Abs(x1 - x2) < (0.0000001 * x1) Then If (yi - y1) * (yi - y2) < 0 Then GoTo 10 Else GoTo 20If (xi - x1) * (xi - x2) < 0 Then GoTo 10GoTo 2010:If Abs(xi - x3) < Abs(0.00001 * xi) And Abs(yi - y3) < Abs(0.00001 * yi) Then GoTo 30If Abs(xi - x4) < Abs(0.00001 * xi) And Abs(yi - y4) < Abs(0.00001 * yi) Then GoTo 30If Abs(x3 - x4) < Abs(0.000001 * yi) Then If (yi - y3) * (yi - y4) < 0 Then GoTo 30 Else GoTo 20If (xi - x3) * (xi - x4) < 0 Then GoTo 30GoTo 2030: F = 120: lngF = FEnd FunctionPublic Function lngF_Rewritten(ByVal xi As Double, _ ByVal x1 As Double, _ ByVal x2 As Double, _ ByVal x3 As Double, _ ByVal x4 As Double, _ ByVal yi As Double, _ ByVal y1 As Double, _ ByVal y2 As Double, _ ByVal y3 As Double, _ ByVal y4 As Double) As Long Dim blnSkip As Boolean Dim F As Double blnSkip = False Select Case (True) Case Abs(xi - x1) < Abs(0.00001 * xi) And Abs(yi - y1) < Abs(0.00001 * yi) Case Abs(xi - x2) < Abs(0.00001 * xi) And Abs(yi - y2) < Abs(0.00001 * yi) Case Abs(x1 - x2) < (0.0000001 * x1) blnSkip = ((yi - y1) * (yi - y2) >= 0) Case (xi - x1) * (xi - x2) < 0 Case Else blnSkip = True End Select ' Select Case (True) If Not (blnSkip) Then blnSkip = False Select Case (True) Case Abs(xi - x3) < Abs(0.00001 * xi) And Abs(yi - y3) < Abs(0.00001 * yi) Case Abs(xi - x4) < Abs(0.00001 * xi) And Abs(yi - y4) < Abs(0.00001 * yi) Case Abs(x3 - x4) < Abs(0.000001 * yi) blnSkip = ((yi - y3) * (yi - y4) >= 0) Case (xi - x3) * (xi - x4) < 0 Case Else blnSkip = True End Select ' Select Case (True) End If ' If Not (blnSkip) Then If Not (blnSkip) Then F = 1 End If ' If Not (blnSkip) Then lngF_Rewritten = FEnd FunctionPublic Sub Test_Q_28322873() Dim xi As Double Dim x1 As Double Dim x2 As Double Dim x3 As Double Dim x4 As Double Dim yi As Double Dim y1 As Double Dim y2 As Double Dim y3 As Double Dim y4 As Double Dim lngRow As Long Application.StatusBar = "Processing - Please wait..." Application.ScreenUpdating = False Application.Calculation = xlCalculationManual [M1].AutoFilter ActiveSheet.Cells.Clear lngRow = 1& Range(Cells(lngRow, 1), Cells(lngRow, 1).Offset(0&, 12)) = Array("xi", "x1", "x2", "x3", "x4", _ "yi", "y1", "y2", "y3", "y4", _ "Original F", _ "Rewritten F", _ "Difference") For xi = 0# To 1# Step 0.5 For x1 = 0# To 1# Step 0.5 For x2 = 0# To 1# Step 0.5 For x3 = 0# To 1# Step 0.5 For x4 = 0# To 1# Step 0.5 For yi = 0# To 1# Step 0.5 For y1 = 0# To 1# Step 0.5 For y2 = 0# To 1# Step 0.5 For y3 = 0# To 1# Step 0.5 For y4 = 0# To 1# Step 0.5 lngRow = lngRow + 1& Range(Cells(lngRow, 1), Cells(lngRow, 1).Offset(0&, 11)) = _ Array(xi, x1, x2, x3, x4, _ yi, y1, y2, y3, y4, _ lngF(xi, x1, x2, x3, x4, yi, y1, y2, y3, y4), _ lngF_Rewritten(xi, x1, x2, x3, x4, yi, y1, y2, y3, y4)) DoEvents Next y4 Next y3 Next y2 Next y1 Next yi Next x4 Next x3 Next x2 Next x1 Next xi Range([M2], Cells(lngRow, "M")).FormulaR1C1 = "=RC[-2]-RC[-1]" [M1].AutoFilter ActiveSheet.Range([A1], Cells(lngRow, "M")).AutoFilter Field:=13, Criteria1:="<>0" If Cells.SpecialCells(xlCellTypeLastCell).Row > 1& Then Cells.SpecialCells(xlCellTypeVisible).EntireRow.Interior.ColorIndex = 3& End If ' If Cells.SpecialCells(xlCellTypeLastCell).Row > 1& Then ActiveSheet.Columns.AutoFit Application.Goto Reference:=[A1], Scroll:=True Application.StatusBar = "Finished" & _ IIf(Cells.SpecialCells(xlCellTypeLastCell).Row > 1&, _ "- Rewritten function failed!", _ " (both results match).") Application.Calculation = xlCalculationAutomatic [M1].AutoFilter [M:M].Delete Application.ScreenUpdating = True MsgBox Application.StatusBar, _ vbInformation Or vbOKOnly, _ ThisWorkbook.Name Application.StatusBar = FalseEnd Sub

I was thinking on a followup question and it appears that your code would be more adaptable to that question compared to the code accepted. Just standby while I prepare the question.

Maybe this

Open in new window

Regards