[ERROR] Error 429 ActiveX component can’t create object

CedricYong · Jan 8th 2021

Hi.

For the past hour I have been trouble shooting my VBA code to resolve the following error when trying to merge excel files with the code, however this error pops up every time on the 2nd phase of the code where it copies all sheets' data onto a single sheet named "Combined", can anyone assist to troubleshoot my code?

Code

Sub Combine()
Dim oWs As Worksheet, TargetWS
    Dim rRng As Range
    Dim iX As Integer
    Dim ws As Worksheet
    Dim c As Range
    
    Sheets(1).Select
    Set TargetWS = Worksheets.Add
    TargetWS.Name = "Combined"
    
    For Each oWs In ThisWorkbook.Worksheets
        Select Case oWs.Name
            Case "Script", "Combined"
                'Do nothing
            Case Else
                iX = iX + 1
                ''/// copy headers first time
                If iX = 1 Then
                    oWs.Range("A1").CurrentRegion.Copy TargetWS.Range("A1")
                Else
                    Set rRng = oWs.Range("A1").CurrentRegion
                    Set rRng = rRng.Offset(1, 0).Resize(rRng.Rows.Count - 1, _
                    rRng.Columns.Count)
                    With TargetWS
                        rRng.Copy .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
                    End With
                    End If
            End Select
    Next oWs
    
    Set ws = ActiveSheet
    With ActiveSheet
        Worksheets(1).Select
        Dim last_row As Long
        last_row = .Cells(.Rows.Count, "A").End(xlUp).Row - 1
        MsgBox (last_row), Title:="Number of transactions"
    End With
    
With ActiveSheet
    Worksheets(1).Select
    Dim lastrow As Long
    lastrow = .Cells(.Rows.Count, "L").End(xlUp).Row
    Dim cl As Range
    For Each cl In Range("L2:L" & lastrow)
        cl = "'000" & cl
    Next cl
    Dim myRange As Range
    Set myRange = Range("L2:L" & lastrow)
    myRange.Replace What:="-", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
End With
    
With ActiveSheet
        Worksheets(1).Select
        Dim sht As Worksheet
        ThisWorkbook.Worksheets("Combined").Cells.EntireColumn.AutoFit
End With
End Sub

Display More

I have attached test files just in case it is needed. Thanks!

CedricYong · Jan 8th 2021

Apologies, this is the full code if needed.

Code

Sub MergeExcelFiles()
    Dim fnameList, fnameCurFile As Variant
    Dim countFiles, countSheets As Integer
    Dim wksCurSheet As Worksheet
    Dim wbkCurBook, wbkSrcBook As Workbook
 
    fnameList = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel files to merge", MultiSelect:=True)
 
    If (vbBoolean <> VarType(fnameList)) Then
 
        If (UBound(fnameList) > 0) Then
            countFiles = 0
            countSheets = 0
 
            Application.ScreenUpdating = False
            Application.Calculation = xlCalculationManual
 
            Set wbkCurBook = ActiveWorkbook
 
            For Each fnameCurFile In fnameList
                countFiles = countFiles + 1
 
                Set wbkSrcBook = Workbooks.Open(Filename:=fnameCurFile)
 
               With wbkSrcBook.Sheets
                    Worksheets(1).Select
                    countSheets = countSheets + 1
                    Worksheets(1).Rows(1).EntireRow.Delete
                    Worksheets(1).Range("L:Q, T:X, AC:AC, AF:AV, AX:DI").EntireColumn.Delete
                    Worksheets(1).Cells.EntireColumn.AutoFit
                    Worksheets(1).Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)
                End With
        For Each wksCurSheet In wbkSrcBook.Sheets
        Next

        For Each wksCurSheet In wbkSrcBook.Sheets
        Worksheets(1).Range("L:Q, T:V, Z:AP, AR:DC").EntireColumn.Delete
        
        Next
        
        For Each wksCurSheet In wbkSrcBook.Sheets

        Worksheets(1).Cells.EntireColumn.AutoFit
        
                Next
                wbkSrcBook.Close SaveChanges:=False
                
            Next
            Application.ScreenUpdating = True
            Application.Calculation = xlCalculationAutomatic
 
            MsgBox "Processed " & countFiles & " files" & vbCrLf & "Merged " & countSheets & " worksheets", Title:="Merge Excel files"
        End If
 
    Else
        MsgBox "No files selected", Title:="Merge Excel files"
    End If
    
    Dim oWs As Worksheet, TargetWS
    Dim rRng As Range
    Dim iX As Integer
    Dim ws As Worksheet
    Dim c As Range
    
    Sheets(1).Select
    Set TargetWS = Worksheets.Add
    TargetWS.Name = "Combined"
    
    For Each oWs In ThisWorkbook.Worksheets
        Select Case oWs.Name
            Case "Script", "Combined"
                'Do nothing
            Case Else
                iX = iX + 1
                ''/// copy headers first time
                If iX = 1 Then
                    oWs.Range("A1").CurrentRegion.Copy TargetWS.Range("A1")
                Else
                    Set rRng = oWs.Range("A1").CurrentRegion
                    Set rRng = rRng.Offset(1, 0).Resize(rRng.Rows.Count - 1, _
                    rRng.Columns.Count)
                    With TargetWS
                        rRng.Copy .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
                    End With
                    End If
            End Select
    Next oWs
    
    Set ws = ActiveSheet
    With ActiveSheet
        Worksheets(1).Select
        Dim last_row As Long
        last_row = .Cells(.Rows.Count, "A").End(xlUp).Row - 1
        MsgBox (last_row), Title:="Number of transactions"
    End With
    
With ActiveSheet
    Worksheets(1).Select
    Dim lastrow As Long
    lastrow = .Cells(.Rows.Count, "L").End(xlUp).Row
    Dim cl As Range
    For Each cl In Range("L2:L" & lastrow)
        cl = "'000" & cl
    Next cl
    Dim myRange As Range
    Set myRange = Range("L2:L" & lastrow)
    myRange.Replace What:="-", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
End With
    
With ActiveSheet
        Worksheets(1).Select
        Dim sht As Worksheet
        ThisWorkbook.Worksheets("Combined").Cells.EntireColumn.AutoFit
End With
End Sub

Display More

**rory** · Jan 11th 2021

Which line causes the error? I can't see any code there that tries to create any objects.

**royUK** · Jan 11th 2021

Some of that code looks like code that I supplied for you. There is nothing in the code that uses ActiveX.

Attach the workbook containing the code.

[ERROR] Error 429 ActiveX component can’t create object

Participate now!

Share

Tags