Need some changes to the below code
This was the code suggested by Reafidy a programmer on stackoverflow. it was working as intended. Need a better optimized code? Now I have to Re-use the same code for a large file.
Sub Delete_Duplicate开发者_如何学编程_Codes()
ThisWorkbook.Worksheets("Data").Activate
Dim vData As Variant, vArray As Variant
Dim lRow As Long
With ActiveSheet.Range("A3", Cells(Rows.Count, "A").End(xlUp)).Offset(, 52)
.FormulaR1C1 = "=RC[-24]&RC[-23]&RC[-19]&RC[-18]&RC[-17]&RC[-16]" ' I know what these meant concatenate A,B,F,G,H,I and I have changed it accordingly
vData = .Resize(, 1).Value
End With
ReDim vArray(1 To UBound(vData, 1), 0)
With CreateObject("Scripting.Dictionary")
For lRow = 1 To UBound(vData, 1)
If Not .exists(vData(lRow, 1)) Then
vArray(lRow, 0) = "x"
.Add vData(lRow, 1), Nothing
End If
Next lRow
End With
Application.ScreenUpdating = False
With ActiveSheet
.Range("BB3").Resize(UBound(vArray, 1)) = vArray
On Error Resume Next
.Range("BA34274", .Cells(Rows.Count, "BA").End(xlUp)).Offset(, 1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
.Columns(52).Resize(, 2).ClearContents ' throwing an error
End With
Application.ScreenUpdating = True
End Sub
He helped me and we have used y and z columns for these purpose Now I have to use BA and BB columns for these task. I dont understand where to make the changes. I replaced z with "BB" and y with "BA" columns but its throwing an error application-defined or object-defined at these line
.Columns(52).Resize(, 2).ClearContents
where I have to make changes and the top 1 and 2 rows are used for headers. The cells starts from 3rd row. Please help me with these code. any help is greatly appreciated
I have changed
.FormulaR1C1 = "=RC[-24]&RC[-23]&RC[-19]&RC[-18]&RC[-17]&RC[-16]" these to
.FormulaR1C1 = "=RC[-52]&RC[-51]&RC[-47]&RC[-46]&RC[-45]&RC[-44]" these
I guess it must be right
You almost had it, it should be:
.Columns(53).Resize(, 2).ClearContents
But I don't see how it could have thrown an error.
Also if you dont like the R1C1 notation you can just use:
With ActiveSheet.Range("A3", Cells(Rows.Count, "A").End(xlUp)).Offset(, 52)
.Formula = "=A3&B3&F3&G3&H3&I3"
vData = .Resize(, 1).value
End With
You should also leave the spaces, it helps with readability.
Sub Delete_Duplicate_Codes()
Dim vData As Variant, vArray As Variant
Dim lRow As Long
With ActiveSheet.Range("A3", Cells(Rows.Count, "A").End(xlUp)).Offset(, 52)
.Formula = "=A3&B3&F3&G3&H3&I3"
vData = .Resize(, 1).value
End With
ReDim vArray(1 To UBound(vData, 1), 0)
With CreateObject("Scripting.Dictionary")
For lRow = 1 To UBound(vData, 1)
If Not .exists(vData(lRow, 1)) Then
vArray(lRow, 0) = "x"
.Add vData(lRow, 1), Nothing
End If
Next lRow
End With
Application.ScreenUpdating = False
With ActiveSheet
.Range("BB3").Resize(UBound(vArray, 1)) = vArray
On Error Resume Next
.Range("BA34274", .Cells(Rows.Count, "BA").End(xlUp)).Offset(, 1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
.Columns(53).Resize(, 2).ClearContents
End With
Application.ScreenUpdating = True
End Sub
精彩评论