cronid
02-28-2008, 07:51 AM
I've got an Excel spreadsheet with 55,000 rows. The name in the third colum repeats for different colleagues in the 13th column. I've written the following VB code to append the colleague name and delete the repeat rows. It works fine until it gets to the 4,000th row. After that the deletes don't work and the program loops appending the same name to the 13th column. There's nothing different about the 4,000th row but I've deleted it as a test. But to no avail. The statement Selection.Rows(rwIndex).EntireRow.Delete does not work when rwIndex gets to 4,000. Does anyone have a suggestion?
Sub CompanyCoverage()
'
'
Dim rwIndex As Integer
Dim prev_name As String
Sheet1.Select
Worksheets("CompanyCoverage1").Select
rwIndex = 1
prev_name = Cells(rwIndex, 3).Value
MsgBox " prev_name is " & prev_name
rwIndex = rwIndex + 1
Do Until rwIndex > 4100
If Cells(rwIndex, 3).Value <> prev_name Then
prev_name = Cells(rwIndex, 3).Value
rwIndex = rwIndex + 1
Else
Cells(rwIndex - 1, 13).Value = Cells(rwIndex - 1, 13).Value & "; " & Cells(rwIndex, 13).Value
'MsgBox " index is " & rwIndex
Selection.Rows(rwIndex).EntireRow.Delete
End If
Loop
End Sub
Sub CompanyCoverage()
'
'
Dim rwIndex As Integer
Dim prev_name As String
Sheet1.Select
Worksheets("CompanyCoverage1").Select
rwIndex = 1
prev_name = Cells(rwIndex, 3).Value
MsgBox " prev_name is " & prev_name
rwIndex = rwIndex + 1
Do Until rwIndex > 4100
If Cells(rwIndex, 3).Value <> prev_name Then
prev_name = Cells(rwIndex, 3).Value
rwIndex = rwIndex + 1
Else
Cells(rwIndex - 1, 13).Value = Cells(rwIndex - 1, 13).Value & "; " & Cells(rwIndex, 13).Value
'MsgBox " index is " & rwIndex
Selection.Rows(rwIndex).EntireRow.Delete
End If
Loop
End Sub