Leaderboard

I have a lot of points as Decimal Degrees, I need code for excel that can help me to 1-remove the duplicate points 2- remove the points with a specific range I can decide Test.xlsx

You are great Bro.

Please find the attachment as per your request EXCEL_FILE.xls

Hello, I need VBA code to sort data automatically from largest to smallest or vice versa.

Private Sub Worksheet_Change(ByVal Target As Excel.Range) If Target.Column = 2 Then Dim lastrow As Long lastrow = Cells(Rows.Count, 2).End(xlUp).Row Range("B2:C" & lastrow).Sort key1:=Range("B2:B" & lastrow), order1:=xlAscending, Header:=xlNo End If End Sub This is the code if someone needs it in the future.

Here's VBA code for sorting using the bubble method. Sub Bubble(n, a, b) 'sorts an array in ascending order using the bubble sort method 'n: the number of elements to be sorted (input) 'a: the unsorted array (input) 'b: the sorted array (output) ' from Chapra, "Power Programming with VBA/Excel", p 156 ' modified by LRM 4/10/2009 to work with Option Base 1 or Base 0 ' Dim m As Integer, i As Integer Dim switch As Boolean Dim dum As Double, Base As Integer Base = 0 ' test if option base is 0 or base 1 If LBound(a) = 1 Then Base = 1 'copy a array to b array For i = Base To Base + n - 1 b(i) = a(i) Next i m = Base + n - 2 Do ' loop through passes switch = False For i = Base To m ' loop through array If b(i) > b(i + 1) Then dum = b(i) b(i) = b(i + 1) b(i + 1) = dum switch = True End If Next i If switch = False Then Exit Do m = m - 1 Loop End Sub

It's allowed, but I'm creating a program so I need all functions to work automatically

Are you not allowed to use the inbuilt Sort function in Excel?

chill out,

Dude since the beginning I was asking for a cod to help me to find similar values, I wonder why you didn't get my point, by the way. I appreciate your kind help.

Thank you guys, @PeterPan9720 @lrm I found a way to help my requirements, but I need VBA code to sort data automatically from largest to smallest or vice versa

I think the following works. I tested it on your data for 4, 5, and 6 decimal places. Option Base 1 Sub test() 'Removes Lat Long coordinates pairs that are duplicated within ' a spedified precision. 'LRM 10 / 29 / 2020 ver 1 Dim LatLong(100, 2) As Variant Dim n As Integer, i As Integer, k As Integer, num As Integer Dim a As Double, b As Double, c As Double, d As Double i = 1 msg = "Please enter desired number of decimal places" & vbCrLf & _ "of desired precision." n = InputBox(msg, "Specify Precision", 6) Range("B2:B2").Select While ActiveCell.Value <> "" LatLong(i, 1) = ActiveCell.Value ActiveCell.Offset(0, 1).Select LatLong(i, 2) = ActiveCell.Value ActiveCell.Offset(1, -1).Select i = i + 1 Wend num = i - 1 LatLong(1, 1) = LatLong(1, 1) LatLong(1, 2) = LatLong(1, 2) For i = 1 To num - 1 k = 0 For j = i + 1 To num a = Round(LatLong(i, 1), n) b = Round(LatLong(j, 1), n) c = Round(LatLong(i, 2), n) d = Round(LatLong(j, 2), n) If a = b And c = d Then ' we have a duplicate k = k + 1 Else LatLong(j - k, 1) = LatLong(j, 1) LatLong(j - k, 2) = LatLong(j, 2) End If Next j Next i ' Output results Range("E2:F101").Select Selection.ClearContents Range("e2:e2").Select For i = 1 To num ActiveCell.Value = LatLong(i, 1) ActiveCell.Offset(0, 1).Select ActiveCell.Value = LatLong(i, 2) ActiveCell.Offset(1, -1).Select If Round(LatLong(i, 1), n) = Round(LatLong(i + 1, 1), n) And _ Round(LatLong(i, 2), n) = Round(LatLong(i + 1, 2), n) Then i = num End If Next i End Sub

Let's say you have a 2 dimensional array named LatLong where the first index is the data number and the second is 1 for latitude and 2 for longitude. i and j are indices indicating which data readings you want to compare. Comparing the two sets of coordinates as follows should tell you if the are "similar" (equal to the number of specified decimal places). n = InputBox("Specify the number of decimal places for comparison." , "Specify Precision", 6) a = Round(LatLong(i, 1), n) b = Round(LatLong(j, 1), n) c = Round(LatLong(i, 2), n) d = Round(LatLong(j, 2), n) If a = b And c = d Then ' we have a duplicate Else ' not a duplicate End If

Dude, Believe me, I have good knowledge about VBA, I tried to work with your solution but I failed maybe there is a misunderstanding, my requirements is a way that's can help me to compare and find the similar values like : 21,649004 39,398330 21,649005 39,398329 As you can see, the numbers are the same except for the sixth number after the comma, it is different If you can write a code to do that, please attach the excel file that's will be kind of you @PeterPan9720

Maybe something in the original file got corrupted and was jambing up in a REGEN between "blank the screen" and "refresh the screen". I've seen similar back in my interactive business applications* programming days. *translated to APPS for you millenials.

Does the following do what you want for removing duplicate coordinate pairs? I had the program output the results into columns E and F. The code does not do any error processing and has only been lightly tested. Option Base 1 Sub test() 'Removes Lat Long coordinates pairs that are duplicated within ' a spedified precision. 'LRM 10 / 29 / 2020 Dim LatLong(100, 2) As Variant Dim LatLongNew(100, 2) As Double Dim n As Integer, i As Integer, k As Integer, num As Integer i = 1 msg = "Please enter desired number of decimal places" & vbCrLf & _ "of desired precision." n = InputBox(msg, "Specify Precision", 6) Range("B2:B2").Select While ActiveCell.Value <> "" LatLong(i, 1) = ActiveCell.Value ActiveCell.Offset(0, 1).Select LatLong(i, 2) = ActiveCell.Value ActiveCell.Offset(1, -1).Select i = i + 1 Wend num = i - 1 k = 1 For i = 1 To num - 1 If Round(LatLong(i, 1), n) <> Round(LatLong(i + 1, 1), n) Then If Round(LatLong(i, 2), n) <> Round(LatLong(i + 1, 2), n) Then ' we don't have a duplicate LatLongNew(k, 1) = LatLong(i, 1) LatLongNew(k, 2) = LatLong(i, 2) k = k + 1 End If End If Next i ' Output results Range("E2:F101").Select Selection.ClearContents Range("e2:e2").Select For i = 1 To k - 1 ActiveCell.Value = LatLongNew(i, 1) ActiveCell.Offset(0, 1).Select ActiveCell.Value = LatLong(i, 2) ActiveCell.Offset(1, -1).Select Next i End Sub

Unfortunately still does not work. @PeterPan9720

I would approach this by first sorting. Then the code is simplified by comparing with the value in the previous line.

Thanks your code was helpful @PeterPan9720

I have good knowledge of IF function, but I need a VBA code in excel. @PeterPan9720

I attached a picture I hope the required is clear now. @PeterPan9720

@PeterPan9720 I didn't find your answer on the Autodesk forum can you please attach the link

Try the 'RECOVER' command worked for me so that stuff must have been somewhere. elektronika1(1).dwg

@Dana W Hehe I remember the days when people talked in full sentences and not 3 and 4 letter abreviations LOL