Per,

Except for my Dim some variables, the code is yours i.e.:
Did I "Dim" properly?

Your code worked for the first 623 records; but failed he

RECORD

622 HolecekElizabeth(999) x62-1121
623 HolecekElizabeth(999) x62-1121 (value of Range("A" & r).Value at failure)
624 HolecekElizabeth(999) x62-1121
625 HolecekElizabeth(999) x62-1121
626 HolecekElizabeth(999) x62-1121
627 HolecekElizabeth(999) x62-1121




Sub ConsolPersonTalents()
'
'Subject: VBA to delete Duplicate Records (1 column) Date: Wed, 19 Aug 2009 09:22:17 +0200
'Date: Wed, 19 Aug 2009 09:22:17 +0200 Per Jessen"
'
'
Dim myRowsToProcess As Long, myColumnsToProcess As Long
Dim myOrigSheetProtectStatus As Boolean
Dim MaxRows As Long
Dim MaxCols As Long
Dim myCell As Range
Dim myRange As Range
Dim UniqueNames As Long
Dim namecounter As Long
Dim r As Long
Dim c As Long
Dim col As Long
Dim myArr()
Dim TargetName As String
MaxRows = Range("A1").CurrentRegion.Rows.Count
MaxCols = Range("A1").CurrentRegion.Columns.Count

If MaxRows = 1 And MaxCols = 1 Then
MsgBox ActiveSheet.Name & " is Empty!"
End If

Range("A1", Range("A1").End(xlDown)).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
UniqueNames = Range("A1", Range("A1").End(xlDown)).SpecialCells(xlCellTypeVi sible).Count - 1
ActiveSheet.ShowAllData
ReDim myArr(1 To UniqueNames, 1 To MaxCols)
TargetName = Range("A2").Value
myArr(1, 1) = TargetName
namecounter = 1

For r = 2 To MaxRows
If Range("A" & r).Value = TargetName Then
For col = 2 To MaxCols
If Cells(r, col).Value < "" Then
myArr(namecounter, col) = Cells(r, col).Value
Exit For
End If
Next
Else
namecounter = namecounter + 1
myArr(namecounter, 1) = Range("A" & r).Value
'************ FAILS here at Record 623 "Subscript out of Range, then "Device I/O error"
For col = 2 To MaxCols
If Cells(r, col).Value < "" Then
myArr(namecounter, col) = Cells(r, col).Value
Exit For
End If
Next
End If
Next

'Parse data to sheet
Range("A2", Cells(MaxRows, MaxCols)).ClearContents
ActiveSheet.UsedRange

For c = 1 To UBound(myArr, 1)
For r = 1 To UBound(myArr, 2)
Cells(c + 1, r) = myArr(c, r)
Next
Next
End Sub

Thanks!



"Per Jessen" wrote:

Per Jessen"