Preserving distinct values VBA excel - deleting all the rest

Question

I have a column with random values that has repeats data in a certain format:

Column 1

A
A
A
A
B
B
C
C
C
A
A
D
D
E
F
F
F
G
...

I tried using

 Dim i As Integer
    Dim noRows As Integer


'count rows
noRows = Range("B2:B10000").Rows.Count

'delete row entries that are duplicates..
For i = 1 To noRows
    If Range("H2").Cells(i + 1, 1) = Range("H2").Cells(i, 1) Then
    Range("H2").Cells(i + 1).Resize(1, 2).Clear
    End If
Next i

Which I quickly realised would not work at all.

how could I write a code so the output would be:

Column 1

A 
[..]
[..]
[..] 
B 
[..] 
C 
[..] 
[..] 
[..] 
A 
D 
[..] 
[..] 
E 
F 
[..] 
[..] 
G 
...

Where the [..]s are nulls or zero

Disregard the second "66.63" field which is green, it should be red

Duplicate question http://stackoverflow.com/questions/31631231/remove-duplicates-from-range-of-cells-in-excel-vba — Jules, Feb 01 '16 at 05:39
I have edited my question to be more specific. Essentially, I want to retain values as long as they are not the same as the immediately previous one, and they should retain their place too.. So: A A B B B C C A A A D D D Becomes A [...] B [...] [...] C [...] A [...] [...] D [...] [...] Quite different from the linked thread where duplicates are removed entirely. — elbarto, Feb 01 '16 at 06:28
Hi, will the duplicates always be directly next to each other like in your example? If so Jules answer can be adapted to work very easily with any length, otherwise you may need some different code. — Josh Whitfield, Feb 01 '16 at 08:46
@JoshWhitfield I've added an image showing what the data set looks like - probably should have done that to begin with! — elbarto, Feb 01 '16 at 22:57

Jules · Accepted Answer · 2016-02-01T23:03:34.710

1

Keep the previous value in a variable and compare it against the cell's value.

Dim sPrv
Dim oRng
Dim i

sPrv = "" '<- previous value
Set oRng = ActiveSheet.Range("H2", ActiveSheet.Range("H2").End(xlDown)) '<- set range of one column starting from H2 to the end of row

Debug.Print oRng.Rows.Count '<- Row count.

For i = 1 To oRng.Rows.Count

    Debug.Print i, sPrv, oRng.Cells(i,1), sPrv = oRng.Cells(i,1) '<- print counter, previous value, cell value, sPrv = Cell ?

    If sPrv = oRng.Cells(i, 1) Then '<- current value the same as previous
        oRng.Cells(i, 1).Value = "" '<- Set the cell value to blank
    Else
        sPrv = oRng.Cells(i, 1).Value '<- Keep the new value for the next comparison and leave the cell value as is
    End If
Next

edited Feb 01 '16 at 23:03

answered Feb 01 '16 at 07:02

Jules

1,423
13
22

Some reason this is not working. My H column range is from H2:H450, so I input: `Sub trial_1() Dim sprv Dim orng Dim i sprv = "" ' – elbarto Feb 01 '16 at 22:44
What is the result after you run the script? Are the values exactly the same (no rounding)? – Jules Feb 01 '16 at 22:54
Yes, it remains the exact same – elbarto Feb 01 '16 at 22:56
I've added debugging lines on the code try that and see what are the values. – Jules Feb 01 '16 at 23:04
Thanks @jules, it still doesn't change anything, however. – elbarto Feb 01 '16 at 23:26
What are the output from debug.print? Do you know how to read the debug result on immediate window? On the visual basic IDE, press ctrl-G to display immediate window . – Jules Feb 01 '16 at 23:29
Sorry, I haven't used that function before; This was the output: http://i.imgur.com/S2LmGv1.jpg – elbarto Feb 01 '16 at 23:33
Let us [continue this discussion in chat](http://chat.stackoverflow.com/rooms/102300/discussion-between-jules-and-elbarto). – Jules Feb 01 '16 at 23:34
you saved my life, thank you Jules. Award this young man money/prizes. – elbarto Feb 01 '16 at 23:40

score 0 · Answer 2 · answered Dec 21 '16 at 11:00

Try this it will work. I have created a fake column which will flag as 1 in that column just to identify the repeat.

Code:

Sub stack()

Dim s1 As Worksheet
Set s1 = Sheets("Sheet1")

For i = 2 To s1.Range("A1").End(xlDown).Row

  If s1.Cells(i, 1).Value = s1.Cells(i - 1, 1) _
       Then
        s1.Cells(i, 2).Value = "1"
    End If
Next

For j = 2 To s1.Range("A1").End(xlDown).Row

    If s1.Cells(j, 2).Value = 1 Then
        s1.Cells(j, 1).Value = "[..]"

    End If
Next

s1.Columns("B").Delete

End Sub

Preserving distinct values VBA excel - deleting all the rest

2 Answers2