[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

Share

Similar Threads

Runtime error 429 (ActiveX component can't create object) and "Microsoft is waiting for another application to complete an OLE action errors

Tags