Dubbele waarde verwijderen

[TwistLok]

Hoi,

Momenteel gebruik ik deze macro om dubbele waardes te verwijderen, werkt perfect als die slecht 2x voorkomt :

Sub Auto_openen()

Dim rng As Variant

rng = ActiveSheet.UsedRange

For i = 5 To Worksheets(1).UsedRange.Rows.Count
If Cells(i, 6) = Cells(i - 1, 6) Then Cells(i, 6) = ""
If Cells(i, 8) = Cells(i - 1, 8) Then Cells(i, 8) = ""
Next
End Sub

Maar deze verwijderd dus enkel de eerste onderliggende dubbele, maar nu komt het voor dat de waarde er tot 4x in voorkomt. Graag had ik dit deze uitgebreid zodat deze ook verwijderd worden.

 

[JeanPaul28]

en hoe komen die daar in

 

[Piet Bom]

Ik heb de VBA code wat aangepast:

Sub Auto_openen()
  Dim rng As Variant
  rng = ActiveSheet.UsedRange
  oud6 = ""
  oud8 = ""
  For i = 5 To Worksheets(1).UsedRange.Rows.Count
'   kolom 6
    If Cells(i, 6).Value = oud6 Then
      Cells(i - 1, 6).Value = ""
      Cells(i, 6).Value = ""
    Else
      oud6 = Cells(i, 6).Value
    End If
'   kolom 8
    If Cells(i, 8).Value = oud8 Then
      Cells(i - 1, 8).Value = ""
      Cells(i, 8).Value = ""
    Else
      oud8 = Cells(i, 8).Value
    End If
  Next
End Sub

 

[TwistLok]

Alvast bedank voor de hulp. De gegevens worden in een template gedumpt door een ander programma,waardes zijn al gesorteerd.
Misschien had ik het niet goed uitgedrukt in de beginpost, maar het is de bedoeling dat er van elke dubbele waarde de bovenste blijft en de dubbele dus vervangen door een blanco cel.
Bv:
1 --> 1
2 2
2
2
3 3
4 4
5 5
5
5
5
enz...

 

[JeanPaul28]

Kan deze inbreng van nut zijn.

 

[TwistLok]

Bedankt, wel een andere aanpak, maar dit doet praktisch hetgeen ik voor ogen had. Mits enkele aanpassingen kom ik er wel, denk ik.

 

[Piet Bom]

Ik heb de VBA code wat aangepast:

Sub Auto_openen()
  Dim rng As Variant
  rng = ActiveSheet.UsedRange
  oud6 = ""
  oud8 = ""
  For i = 5 To Worksheets(1).UsedRange.Rows.Count
'   kolom 6
    If Cells(i, 6).Value = oud6 Then
      Cells(i, 6).Value = ""
    Else
      oud6 = Cells(i, 6).Value
    End If
'   kolom 8
    If Cells(i, 8).Value = oud8 Then
      Cells(i, 8).Value = ""
    Else
      oud8 = Cells(i, 8).Value
    End If
  Next
End Sub

dan moet je 2 regels weglaten.......

 

[TwistLok]

Inderdaad Piet, was me eerlijk gezegd er wat op aan het blindstaren. Bedankt voor de snelle afhandeling