Solved

Convert code from unstructured to structured

Posted on 2013-12-20
12
328 Views
Last Modified: 2013-12-20
Can someone rewrite this code such that there are no line numbers.

If Abs(xi - x1) < Abs(0.00001 * xi) And Abs(yi - y1) < Abs(0.00001 * yi) Then GoTo 10
If Abs(xi - x2) < Abs(0.00001 * xi) And Abs(yi - y2) < Abs(0.00001 * yi) Then GoTo 10
If Abs(x1 - x2) < (0.0000001 * x1) Then If (yi - y1) * (yi - y2) < 0 Then GoTo 10 Else GoTo 20
If (xi - x1) * (xi - x2) < 0 Then GoTo 10
GoTo 20
10
If Abs(xi - x3) < Abs(0.00001 * xi) And Abs(yi - y3) < Abs(0.00001 * yi) Then GoTo 30
If Abs(xi - x4) < Abs(0.00001 * xi) And Abs(yi - y4) < Abs(0.00001 * yi) Then GoTo 30
If Abs(x3 - x4) < Abs(0.000001 * yi) Then If (yi - y3) * (yi - y4) < 0 Then GoTo 30 Else GoTo 20
If (xi - x3) * (xi - x4) < 0 Then GoTo 30
GoTo 20

30 F = 1

20 

Open in new window

0
Comment
Question by:Saqib Husain, Syed
  • 6
  • 2
  • 2
  • +2
12 Comments
 
LVL 13

Expert Comment

by:Alexander Eßer [Alex140181]
ID: 39731272
Looks like homework ;-)
0
 
LVL 43

Author Comment

by:Saqib Husain, Syed
ID: 39731314
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
 
LVL 48

Accepted Solution

by:
Rgonzo1971 earned 500 total points
ID: 39731322
Hi,

Maybe this

If Abs(xi - x1) < Abs(0.00001 * xi) And Abs(yi - y1) < Abs(0.00001 * yi) Or _
    Abs(xi - x2) < Abs(0.00001 * xi) And Abs(yi - y2) < Abs(0.00001 * yi) Or _
    (xi - x1) * (xi - x2) < 0 Or _
    Abs(x1 - x2) < (0.0000001 * x1) And ((yi - y1) * (yi - y2) < 0) Then 
    If Abs(xi - x3) < Abs(0.00001 * xi) And Abs(yi - y3) < Abs(0.00001 * yi) Or _
        Abs(xi - x4) < Abs(0.00001 * xi) And Abs(yi - y4) < Abs(0.00001 * yi) Or _
        (xi - x3) * (xi - x4) < 0 Or _
        Abs(x3 - x4) < Abs(0.000001 * yi) And ((yi - y3) * (yi - y4) < 0) Then
            F = 1
    End If
End If

Open in new window

Regards
0
 
LVL 13

Expert Comment

by:Alexander Eßer [Alex140181]
ID: 39731328
Are you competent to do this or are you just trying to enjoy?
Don't be so rude! I didn't want to bother you, I was just asking ;-)
0
 
LVL 43

Author Comment

by:Saqib Husain, Syed
ID: 39731359
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.
0
 
LVL 31

Expert Comment

by:Rob Henson
ID: 39731412
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!

Thanks
Rob H
0
Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

 
LVL 43

Author Closing Comment

by:Saqib Husain, Syed
ID: 39731671
Spot on. Thanks.

Saqib
0
 
LVL 35

Expert Comment

by:[ fanpages ]
ID: 39731697
Hi,

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 Explicit
Public 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 Long
  
If Abs(xi - x1) < Abs(0.00001 * xi) And Abs(yi - y1) < Abs(0.00001 * yi) Then GoTo 10
If Abs(xi - x2) < Abs(0.00001 * xi) And Abs(yi - y2) < Abs(0.00001 * yi) Then GoTo 10
If Abs(x1 - x2) < (0.0000001 * x1) Then If (yi - y1) * (yi - y2) < 0 Then GoTo 10 Else GoTo 20
If (xi - x1) * (xi - x2) < 0 Then GoTo 10
GoTo 20

10:
If Abs(xi - x3) < Abs(0.00001 * xi) And Abs(yi - y3) < Abs(0.00001 * yi) Then GoTo 30
If Abs(xi - x4) < Abs(0.00001 * xi) And Abs(yi - y4) < Abs(0.00001 * yi) Then GoTo 30
If Abs(x3 - x4) < Abs(0.000001 * yi) Then If (yi - y3) * (yi - y4) < 0 Then GoTo 30 Else GoTo 20
If (xi - x3) * (xi - x4) < 0 Then GoTo 30
GoTo 20

30:
  F = 1

20:
  lngF = F
  
End Function
Public 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 = F
  
End Function
Public 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 = False
  
End Sub

Open in new window


BFN,

fp.
Q-28322873.xlsm
0
 
LVL 43

Author Comment

by:Saqib Husain, Syed
ID: 39731737
Wow you really spent a lot of time on this.

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.
0
 
LVL 43

Author Comment

by:Saqib Husain, Syed
ID: 39731763
0
 
LVL 35

Expert Comment

by:[ fanpages ]
ID: 39731941
:)  That's OK.

Just take what I have provided & edit it to suit.  No need for a new question.  Please close/delete that one if you wish to.
0
 
LVL 43

Author Comment

by:Saqib Husain, Syed
ID: 39732258
I was going to put that question anyways.
0

Featured Post

Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

Join & Write a Comment

Whether you've completed a degree in computer sciences or you're a self-taught programmer, writing your first lines of code in the real world is always a challenge. Here are some of the most common pitfalls for new programmers.
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

758 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

23 Experts available now in Live!

Get 1:1 Help Now