Jump to content

Please I need urgent Excel code


Kalsefar

Recommended Posts

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

 

 

2020-10-27_233518.jpg

Test.xlsx

Edited by Kalsefar
  • Thanks 1
Link to comment
Share on other sites

1 minute ago, Kalsefar said:

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

Coulisse you share the excel file? And an example of the required result?? 

Link to comment
Share on other sites

24 minutes ago, Kalsefar said:

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

 

 

2020-10-27_233518.jpg

If you can share the file should be better for testing procedure. What the sentence "last number" ?

Edited by PeterPan9720
Link to comment
Share on other sites

1 minute ago, Kalsefar said:

That's the problem of how I can find similar data by specific value

@PeterPan9720

https://www.ablebits.com/office-addins-blog/2016/03/02/identify-duplicates-excel/#identify-duplicates-excel

You can find equal not similar, for similar you have to define a criteria ! 1 decimal point ? n decimal point ?... look at link

Link to comment
Share on other sites

8 hours ago, Kalsefar said:

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

@PeterPan9720

Sub test()
For Each cell In ThisWorkbook.Sheets(1).Range("B2:B15")
    Set Arg1 = Sheets(1).Range("B2:B15")
    Arg2 = Sheets(1).Range("B" & cell.Row).Value
    Set Arg3 = Sheets(1).Range("C2:C15")
    Arg4 = Sheets(1).Range("C" & cell.Row).Value
    Sheets(1).Range("E" & cell.Row).Value = Application.WorksheetFunction.CountIfs(Arg1, Arg2, Arg3, Arg4) > 1
Next
End Sub

@Kalsefar

If the value of Cells in column "E" will be true means that cell with lat & long on specific row it's duplicated, if false not.

Of course you can use a wide range, more filtering criteria adding Arg to function, and a variable instead writing a value TRUE or FALSE in the specific cell.If you want you can delete the Row, everything checking if result from function it's true or false.

Test.xlsx

Edited by PeterPan9720
  • Thanks 1
Link to comment
Share on other sites

8 minutes ago, Kalsefar said:

Thanks your code was helpful

@PeterPan9720 

@Kalsefar,

It was only helpful or did you solve your issue ?

If you remove from the function the check ">1" the function return the amount of duplicated cells as 1 or 2 or more it's depending from how many times the criteria count will be true.

Of course you will find 2 times or more the duplicated value because during the scan of entire range the first cell range will be duplicated and continuing the scan up to the last range value the second cell duplicated value has been found. See attached column "F".

Test.xlsx

Link to comment
Share on other sites

No didn't solve my issue,
its help me with duplicate but I need something help me with similar values like (23.855024), (23855025
So I need to highlight or write ( False ) on one of the the mentioned above value 

@PeterPan9720

Link to comment
Share on other sites

2 hours ago, Kalsefar said:

No didn't solve my issue,
its help me with duplicate but I need something help me with similar values like (23.855024), (23855025
So I need to highlight or write ( False ) on one of the the mentioned above value 

@PeterPan9720

Add a range and  criteria , or place another count if only with higher or lower criteria, the function it's always the same.

Set Arg5 = Sheets(1).Range("C2:C15")
Arg6 = Sheets(1).Range("C" & cell.Row).Value > 0,0001 'Example
Sheets(1).Range("E" & cell.Row).Value = Application.WorksheetFunction.CountIfs(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6) > 1
Edited by PeterPan9720
Link to comment
Share on other sites

1 hour ago, Kalsefar said:

Unfortunately still does not work.

@PeterPan9720

Ok did you define a criteria ? what I showed in my previous post it's only an example, you should define a criteria, a cells value between it's considered similar each others.

Try to separate from duplicated function value, just to understand if it's working, look on web there are a lot of literature on Excel function and VBA, see for example https://stackoverflow.com/questions/32332301/how-to-use-countifs-formula-in-vba web site.

Made experiment, I cannot make miracle, and I don't know your requirements.

Again you should create a your criteria of selected value for example cell A2 value between cell A3 +/- 0,00001.

One range -> One criteria -> One Arg..n in the function. Try with a couple of cells.

 

Link to comment
Share on other sites

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

 

  • Thanks 1
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...