Find consecutively and copy

[LuisE]

I need to scan all used cells in column C from top to bottom and for those
with more than one occurence copy the cell contents one column to the left
and add as many "i" at the end as that cell is an occurence of the searched
cell or the occurence number.

Option Explicit
Sub wwweee()

Dim OccurCount As Long
Dim CellFound As Range
Dim i As Integer

For i = 1 To Range("C3").SpecialCells(xlLastCell).Row

For OccurCount = 1 To WorksheetFunction.CountIf(Columns(3), Cells(i, 3))
Set CellFound = Columns(3).Find(What:=Cells(i, 3).Value,
After:=Cells(i,3), LookIn:=xlValues, LookAt:=xlPart,
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)

Cells(i, 2).Value = Cells(i, 3).Value & OccurCount - 1
Next OccurCount
Next i
End Sub

Thanks in davance

 

[Dave Peterson]

Can you use a formula like this in D1:
=C1 & "-(" & COUNTIF($C$1:C1,C1) & ")"
And drag down?

If this is close, maybe you can modify this code:

Option Explicit
Sub testme01()

Dim LastRow As Long
Dim wks As Worksheet

Set wks = Worksheets("Sheet1")

With wks
LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
With .Range("D1:d" & LastRow)
.FormulaR1C1 _
= "=rc[-1] & ""-("" & countif(r1c3:rc[-1],rc[-1]) & "")"""
.Value = .Value
End With
End With

End Sub

 

[LuisE]

Thanks Dave. You are always very helful.

Could you please take a look at this post and help me?

"Shif cells to the right and down within limits"