VBA Error Message.... What am i missing?

[SamBo1234]

Hi all,

I have the following Code which works when i run it manually,


MODULE1

Option Explicit

Sub CombineWorkbooks()
    Dim FilesToOpen
    Dim x As Integer
    Dim ShCnt As Integer
    Dim i As Integer

    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="Microsoft Excel Files (*.xls), *.xls", _
      MultiSelect:=True, Title:="Files to Merge")

    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
        GoTo ExitHandler
    End If

    x = 1
    While x <= UBound(FilesToOpen)
        Workbooks.Open Filename:=FilesToOpen(x)
        
        With ThisWorkbook
        ShCnt = .Sheets.Count
        Sheets().Move After:=.Sheets(ShCnt)
            For i = ShCnt + 1 To .Sheets.Count
      .Sheets(i).Range("I1") = Dir(FilesToOpen(x))
        Range("I1").Select
        Selection.Font.Bold = True
            Next i
        End With
        
        x = x + 1
    Wend

ExitHandler:
    Application.ScreenUpdating = True
    Exit Sub

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub

(It basically combines workbooks into one, This works and i have no problems)

This is my code for creating a button on the menu, and runs the SUB above when clicked.


THIS WORKBOOK

Option Explicit


Dim sMenu As String


Private Sub Workbook_BeforeClose(Cancel As Boolean)


    sMenu = "myButton"


    On Error Resume Next
    Application.CommandBars("Formatting").Controls(sMenu).Delete
    On Error GoTo 0
End Sub


Private Sub Workbook_Open()
Dim oCB As CommandBar
Dim oCtl As CommandBarControl
Dim newMenu As Object 'CommandBarControl
Dim ctrlButton As Object 'CommandBarControl


    sMenu = "Merge Workbooks"


    On Error Resume Next
    Application.CommandBars("Formatting").Controls(sMenu).Delete
    On Error GoTo 0


    Set oCB = Application.CommandBars("Formatting")
    Set oCtl = oCB.Controls.Add(Type:=msoControlButton, temporary:=True)


    With oCtl
        .BeginGroup = True
        .Caption = sMenu
        .FaceId = 197
        .Style = msoButtonIconAndCaption
        .OnAction = "CombineWorkbooks"
        
    End With


End Sub

When i click my pre made button it then runs the SUB to Combine workbooks but i get the following error message....


Microsoft Excel
Method 'Move' of objects 'Sheets' failed


Any ideas?

The top SUB works when i run it manually, but not when i run it when i click the button.... i cant figure it out.

FYI This is a XLA Addin i have created.

Ty for any input.
Sam

 

[Richard Schollar]

Hi Sam

Where do you house the CombineWorkbooks code? Ie in which workbook is the module?

Richard

 

[SamBo1234]

Hi Richard,

I have created a XLA, which houses all the code.

The workbook is called: Merge_Workbooks_V1.00_Ad-In.XLA

Then residing within the XLA there is...

ThisWorkbook: Which Houses the CombineWorkbooks Code

Which is in Microsoft Excel Objects.

Module1: Which Houses the 'Button Creation Code'

Which is in Modules

 

[Richard Schollar]

I think your problem stems from using ThisWorkbook in the CombineWorkbooks code:

With ThisWorkbook 
        ShCnt = .Sheets.Count 
        Sheets().Move After:=.Sheets(ShCnt) 
            For i = ShCnt + 1 To .Sheets.Count 
                 With .Sheets(i)
                     .Range("I1") = Dir(FilesToOpen(x)) 
                     .Range("I1").Font.Bold = True 
                  End With
            Next i 
End With

Seeing as "Thisworkbook" refers to the xla file. Potentially, you could try using Activeworkbook or possibly FilesToOpen(1) or some such.

Richard

 

[SamBo1234]

Hi Richard,

Thanks for the reply,

Replacing ThisWorkbook with ActiveWorkbook doesnt help as i end up with Workbooks which are opened up seperatley from the initial selection and are not Combined into one, which the orginal code does when run manually.

Can you offer any alternative to get around my problem?

Many Thanks
Sam

 

[Richard Schollar]

Sam

It depends on what you want ThisWorkbook to be - if it is one of the FilesToOpen then you can specify it by referring to its index (and not modifying the index at each loop/iteration), so you could use FilesToOpen(1) in place of ThisWorkbook.

Richard

 

[SamBo1234]

Hi Richard,

Would it be possible to update the code for me?, both the Module Code, and the Workbook code.... All im trying to do is get the two to work together which is giving me a headache... and as im a little crap at VBA, i wouldnt mind your help!

As long as the CombineWorkbook code runs and performs its job (Which it currently does when i run it on its own) and the Button Works and the total XLA file works then ill be a very very happy man!.

Regards
Sam

 

[Richard Schollar]

Sam

This is a bit of a stab in the dark but try:

Module1

Option Explicit 

Sub CombineWorkbooks() 
    Dim FilesToOpen 
    Dim x As Integer 
    Dim ShCnt As Integer 
    Dim i As Integer 

    On Error GoTo ErrHandler 
    Application.ScreenUpdating = False 

    FilesToOpen = Application.GetOpenFilename _ 
      (FileFilter:="Microsoft Excel Files (*.xls), *.xls", _ 
      MultiSelect:=True, Title:="Files to Merge") 

    If TypeName(FilesToOpen) = "Boolean" Then 
        MsgBox "No Files were selected" 
        GoTo ExitHandler 
    End If 

    x = 1 
    While x <= UBound(FilesToOpen) 
        Workbooks.Open Filename:=FilesToOpen(x) 
        
        With FilesToOpen(1) 
                ShCnt = .Sheets.Count 
                Sheets().Move After:=.Sheets(ShCnt) 
                For i = ShCnt + 1 To .Sheets.Count 
                   .Sheets(i).Range("I1") = Dir(FilesToOpen(x)) 
                   .Sheets(i).Range("I1").Font.Bold = True 
                Next i 
        End With 
        
        x = x + 1 
    Wend 

ExitHandler: 
    Application.ScreenUpdating = True 
    Exit Sub 

ErrHandler: 
    MsgBox Err.Description 
    Resume ExitHandler 
End Sub

ThisWorkbook

Option Explicit 


Dim sMenu as String


Private Sub Workbook_BeforeClose(Cancel As Boolean) 
    sMenu = "Merge Workbooks"
    On Error Resume Next 
    Application.CommandBars("Formatting").Controls(sMenu).Delete 
    On Error GoTo 0 
End Sub 


Private Sub Workbook_Open() 
Dim oCB As CommandBar 
Dim oCtl As CommandBarControl 


    sMenu = "Merge Workbooks" 


    On Error Resume Next 
    Application.CommandBars("Formatting").Controls(sMenu).Delete 
    On Error GoTo 0 


    Set oCB = Application.CommandBars("Formatting") 
    Set oCtl = oCB.Controls.Add(Type:=msoControlButton, temporary:=True) 


    With oCtl 
        .BeginGroup = True 
        .Caption = sMenu 
        .FaceId = 197 
        .Style = msoButtonIconAndCaption 
        .OnAction = "CombineWorkbooks" 
        
    End With 


End Sub

Plonk it in and give it a whirl.

Richard

 

[SamBo1234]

Thanks Richard,

Im now getting the following error.


Microsoft Excel
Object Required
OK

 

[Richard Schollar]

Ah, my mistake - try this amended code:

Option Explicit 

Sub CombineWorkbooks() 
    Dim FilesToOpen 
    Dim x As Integer 
    Dim ShCnt As Integer 
    Dim i As Integer, strFile as String

    On Error GoTo ErrHandler 
    Application.ScreenUpdating = False 

    FilesToOpen = Application.GetOpenFilename _ 
      (FileFilter:="Microsoft Excel Files (*.xls), *.xls", _ 
      MultiSelect:=True, Title:="Files to Merge") 

    If TypeName(FilesToOpen) = "Boolean" Then 
        MsgBox "No Files were selected" 
        GoTo ExitHandler 
    End If 

    x = 1 
    strFile = right(FilesToOpen(1),len(FilesToOpen(1))-instrrev(FilesToOpen(1),"\"))
    While x <= UBound(FilesToOpen) 
        Workbooks.Open Filename:=FilesToOpen(x) 
        
        With Workbooks(strFile) 
                ShCnt = .Sheets.Count 
                Sheets().Move After:=.Sheets(ShCnt) 
                For i = ShCnt + 1 To .Sheets.Count 
                   .Sheets(i).Range("I1") = Dir(FilesToOpen(x)) 
                   .Sheets(i).Range("I1").Font.Bold = True 
                Next i 
        End With 
        
        x = x + 1 
    Wend 

ExitHandler: 
    Application.ScreenUpdating = True 
    Exit Sub 

ErrHandler: 
    MsgBox Err.Description 
    Resume ExitHandler 
End Sub

Note that it's only the CombineWorkbooks macro that has changed.

Richard