PDA

View Full Version : Solved: copying rows matching criteria from a column



sasa
05-04-2008, 12:47 AM
I need a little help. I have this macro:
Sub CopyAndInsertRows()
Application.ScreenUpdating = False
Dim iCount As Integer
iCount = 1
Do
Selection.EntireRow.Copy
Selection.Insert Shift:=xlDown
iCount = iCount - 1
Loop Until iCount = 0
Application.ScreenUpdating = True
End Sub

It copy and insert row after I select a particular row. But I need to modify this the way it copy and insert a row the same way it does it but on matching criteria.

Example: It duplicates on column A all the rows where I Have the same item:
Before

a
b
c
d
after
a
a
b
c
d

thank you on advance

Sasa

Bob Phillips
05-04-2008, 01:22 AM
Why is the a duplicated, but none of the others?

sasa
05-04-2008, 01:29 AM
Why is the a duplicated, but none of the others?

it is the result I need.

I just need a macro that duplicate a row only if the item in the row, in this case "a" matches with a preset item, in my example "a".

Bob Phillips
05-04-2008, 02:30 AM
OK, it would have been good to mention that first time!



Public Sub ProcessData()
Dim i As Long
Dim LastRow As Long

With ActiveSheet

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = LastRow To 1 Step -1

If .Cells(i, "A").Value = "a" Then

.Rows(i).Copy
.Rows(i + 1).Insert
End If
Next i
End With

End Sub

sasa
05-04-2008, 04:44 AM
Great work !! It works successfully. Is there the chance to have in red the duplicates items ?
Anyway thank you very much

Sasa

Bob Phillips
05-04-2008, 07:28 AM
Public Sub ProcessData()
Dim i As Long
Dim LastRow As Long

With ActiveSheet

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = LastRow To 1 Step -1

If .Cells(i, "A").Value = "a" Then

.Rows(i).Copy
.Rows(i + 1).Insert
.Rows(i + 1).Font.ColorIndex = 3
End If
Next i
End With

End Sub

sasa
05-04-2008, 09:55 AM
thank you again !

Sasa

mdmackillop
05-05-2008, 12:49 AM
Hi Sasa,
To mark a thread Solved, use the Thread Tools dropdown