开发者

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
0

上一篇:

下一篇:

精彩评论

暂无评论...
验证码 换一张
取 消

最新问答

问答排行榜