PDA

View Full Version : [SOLVED] Auto-remove duplicates from dynamic list



Alephus
01-27-2016, 11:06 PM
Hello there again

As title says, i have a list with values being pseudo-randomly generated into the top row of sayd list (Row 18). the last cell of that row (K18) then proceeds to create an ID of the values of that row using =Concatenate(cell1; cell2; etc....)

The problem here is that, since the values are being pseudo-randomly generated, there is a change of a duplicate row appearing (wich also makes a duplicate ID). Here is a preview of the list at the moment:

15304

Detecting and eliminating the duplicates is not the problem actually, Excel already has a button for that. The problem is, since the list is always increasing in size each time a new row is made, how can i detect how big the list is (from D18 to K#) so then i can proceed to detect and delete the duplicates?

Another way i tryed was to select the entire collum with the ID's so after i can proceed to detect duplicates and delete their entire row. The problem in this way is that the filters mess everything up when trying to detect and erase duplicates

Any sugestions?

Alephus
01-27-2016, 11:56 PM
Update:

Here's what i have atm:


Sub DelDups()
Dim iListCount As Integer
Dim iCtr As Integer
Dim iCtl As Integer


Application.ScreenUpdating = False
iCtl = 0
Range("K18").Select
Do Until ActiveCell = ""
iCtl = iCtl + 1
Range("C17").Select
ActiveCell = 18 + iCtl
Range("K" & Range("C17").Text).Select
Loop






iListCount = Range("K18:K" & Range("C17").Text).Rows.Count
Range("K18").Select


Do Until ActiveCell = ""

For iCtr = 1 To iListCount

If ActiveCell.Row <> Cells(iCtr + 18, 11).Row Then

If ActiveCell.Value = Cells(iCtr + 18, 11).Value Then

Cells(iCtr + 18, 11).Delete xlShiftUp

iCtr = iCtr + 1
End If
End If
Next iCtr

ActiveCell.Offset(1, 0).Select
Loop
Application.ScreenUpdating = True
End Sub

Not working properly, test have showed it doesnt delete duplicates if theres more than 1 and doesnt delete the entire row...

JKwan
01-28-2016, 08:41 AM
give this a try

Option Explicit
Sub RemoveDup()
Dim LastRow As Long
Dim lRow As Long
Dim WSInput As Worksheet

Set WSInput = ThisWorkbook.Worksheets("Sheet1")
LastRow = FindLastRow(WSInput, "D")
On Error GoTo Dup
With CreateObject("scripting.dictionary")
For lRow = LastRow To 18 Step -1
.Add Trim(WSInput.Cells(lRow, "K")), Trim(WSInput.Cells(lRow, "K"))
Next lRow
End With

On Error Goto 0
Set WSInput = Nothing
Exit Sub

Dup:
Rows(lRow & ":" & lRow).Delete
Resume Next
End Sub
Function FindLastRow(ByVal WS As Worksheet, ColumnLetter As String) As Long
FindLastRow = WS.Range(ColumnLetter & Rows.Count).End(xlUp).Row
End Function

Alephus
01-28-2016, 09:03 AM
Thanks for the answer

but it gives the following error: (mind that i have to translate the error since my software is in Portuguese)


Microsoft Visual Basic

Execution time error "13":

Correspondancy Error

and when i go to check whats wrong, VBA is selecting the following line:



Rows(lRow & ":" & lRow).Delete

any sugestion?

snb
01-28-2016, 09:25 AM
Apparently this is not the safest way to generate unique values/items.

Why are you doing this, because I fear we can accomplish what you are looking for in 3 lines of VBA-code.

JKwan
01-28-2016, 09:43 AM
Just a guess, maybe your filter is on, try remove your filter before you run the code. I have no error when I was running it.

Alephus
01-28-2016, 09:49 AM
Well here is the reason:

I have 6 groups (Arcane, Cold, Fire, Blade, Impact and Pierce) as showed on the table and each can have a value from 0 to 100 (By increments of 10). BUT the total value for all of those must be 240. Then, If one of those values is lower than 50, it will be duplicated to a maximum of 50 (so 10 becomes 20, 20 becomes 40, 30 becomes 50 and 40 becomes 50). After, add all resulting values to get a Max value (must be higuer than 300, if not try again) and store it on a list.

Heres a short example:



Arcane - 20 - 40
Cold - 40 - 50
Fire - 30 - 50
Blade - 90 - 90
Pierce - 30 - 50
Impact - 20 - 40

Total - 240 - 320


That system i have done. The thing is the system i have generates the values by spreading the 240 "points" to the 6 groups randomly OR (i have 2 systems) by generating random values in each group from (0:10)*10 until the sum of all groups = 240. So there is the chance of the same set of values appearing again in either system.

The purpose is to get all possible combinations so the resulting value is 300 or more

If you want to check the macros and the rest of the spreedsheet so far, heres a dropbox link to it

https://www.dropbox.com/s/bzex4vimlo8u9vq/SortSheet.xlsm?dl=0

Alephus
01-28-2016, 09:53 AM
Just a guess, maybe your filter is on, try remove your filter before you run the code. I have no error when I was running it.

yes filter was on, but even with filter off it still gives the exact same error

JKwan
01-28-2016, 09:58 AM
Well, I don't know what to say.... I downloaded your file and I ran the macro, no error. I hit the Copiar button 15 times, ran the macro, it found several duplicates and deleted them.

Alephus
01-28-2016, 09:59 AM
dam... maybe its because my excel version is both in Portuguese and on mac?

JKwan
01-28-2016, 10:14 AM
Well, then I believe it is that you are running Excel on Mac. You will need to find the proper syntax for the delete function. Since I am on Windows, I cannot help you there. Maybe google the Rows function and update the command accordingly.

Alephus
01-28-2016, 10:31 AM
I believe you are correct after a quick search. It seems mac changed the way rows are interpreted.

But i will mark this thread as solved since the main problem is solved in windows (wich is actually my main OS, just being repaired due to a power surge)
I will try a few different aproaches in the meanwhile and see if i can create a version of your macro for mac.

Thanks for the support JKwan and snb