ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Find consecutively and copy (https://www.excelbanter.com/excel-programming/419756-find-consecutively-copy.html)

LuisE

Find consecutively and copy
 
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

Find consecutively and copy
 
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 wrote:

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

LuisE

Find consecutively and copy
 
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"



All times are GMT +1. The time now is 07:46 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com