??Find and Replace Duplicate Cells

J

JBL

Hello,

I am working in Excel 2002 VBA and have built a macro from a userform to
take and insert a blank row under each existing row that has data (4
columns) to the end of the rows that have data.

I then copy the data immediatley above the newly inserted blank row to the
new blank row. So far so good by using Do and Loop commands and an If
argument to End the routine at the end of the row.

I now need to take one column and find duplicate cell contents (all text
format) and to each second occurence I need to add a trailing letter "P"

All the data in each cell in the range ( column2) is 6 characters and is
mixed content but each original row of data has a unique field untill I run
the macro to insert a row and copy the preceeding row.

Assuming that the data is correct from my import routine (it comes from a
delimited file and this 6 digit alpha numeric text is the key field) then I
could start at a selected cell since I know the next cell below is a
duplicate and simply add a string "Y" to every Offset (2, 0) cell till end
of row?

My mind is blank on how to accomplish this since VBA does not use concanate
and I have little experience in modifying strings. I tried Union, but to no
avail and I need to do this and I am running out of patience.

Help!!!!!

Jeremy
 
F

Frank Kabel

Hi
see the following site as a starting point:
http://www.cpearson.com/excel/deleting.htm#DeleteDuplicateRows

In your case you may use the following code:
Public Sub DeleteDuplicateRows()
'
' This macro deletes duplicate rows in the selection. Duplicates are
' counted in the COLUMN of the active cell.

Dim Col As Integer
Dim r As Long
Dim C As Range
Dim N As Long
Dim V As Variant
Dim Rng As Range

On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Col = ActiveCell.Column

If Selection.Rows.Count > 1 Then
Set Rng = Selection
Else
Set Rng = ActiveSheet.UsedRange.Rows
End If

N = 0
For r = Rng.Rows.Count To 1 Step -1
V = Rng.Cells(r, 1).Value
If Application.WorksheetFunction.CountIf(Rng.Columns(1), V) > 1
Then
Rng.Cells(r, 1).Value = Rng.Cells(r, 1).Value & "P"
N = N + 1
End If
Next r

EndMacro:

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub
 
J

JBL

Thanks Frank,

This is the version of the routine I am using to insert a new blank row and
copy the data from above down to this blank row, but I don't want to remove
duplicates, I want to change the value of one cell in each row by adding the
"P" to the string in the cell.

Maybe I am dense, but this looks like it will go through all rows that have
been used on the sheet at any given time by the UsedRange command.

Doesn't VB considers a cell used even if the contents and formatting have
been erased; however, VB I understand does resets the used range to after
the file has been saved. In this case I am not saving the file before the
execution of all macros.

I must admit you have turned on a switch in my pitiful brain since I can
used the Concatenate Function from the work sheet and step through each row
by the Offset comand till I reach a blank field.

Any other ideas?

Jeremy
 
F

Frank Kabel

Hi
just try the macro: I just forgot to rename the procedure name. Though
it stated 'Delete...' it just adds a character to your data :)
 
Top