Assigned macro to a button won't launch, but will through View Macros

S

Sir Rossdale the Gallant

New Member
Joined
Apr 6, 2022
Messages
6
Office Version
  1. 365
Platform
  1. Windows
Hello everyone,

Why is it that when I run the sample macro below (it's not the whole code, just the beginning) via "View Macros," it runs fine and prompts me to locate the Excel file to open, but if I assign it to a button, it gives me a File in Use error dialog box and asks me if I want to view a Read-Only copy? Am I not properly assigning the workbooks names? Thanks in advance!

VBA Code: 
Sub a__Initial_Letters_Run_LAC_SRC_LTR2_File()

Dim SrcWbk As Workbook
Dim DestWbk As Workbook
Dim file_name As Variant

Set DestWbk = ThisWorkbook
file_name = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", title:="Select the Offer Letters Excel file")
If file_name = "False" Then Exit Sub

Set SrcWbk = Workbooks.Open(file_name)
    

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Sheets("Table 2").Select
    Sheets("Table 2").Copy Before:=Sheets(2)
    Sheets("Table 2 (2)").Select
    Sheets("Table 2 (2)").Move Before:=Sheets(1)
    Sheets("Table 2 (2)").Select
    Sheets("Table 2 (2)").Name = "MASTER"
    Cells.Select
    Selection.Delete Shift:=xlUp
    Range("A1").Select
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
Sort by date Sort by votes
The obvious answer is when you tested it from Run Macro, the file was left open when you were finished, then when you tried it with the button it was still open.

Please show all of the code.
 
Upvote 0
Sorry -- here's the rest of the code:

VBA Code: 
Sub a__Initial_Letters_Run_LAC_SRC_LTR2_File()

Dim SrcWbk As Workbook
Dim DestWbk As Workbook
Dim file_name As Variant

Set DestWbk = ThisWorkbook
file_name = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", title:="Select the Offer Letters Excel file")
If file_name = "False" Then Exit Sub

Set SrcWbk = Workbooks.Open(file_name)
    

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Sheets("Table 2").Select
    Sheets("Table 2").Copy Before:=Sheets(2)
    Sheets("Table 2 (2)").Select
    Sheets("Table 2 (2)").Move Before:=Sheets(1)
    Sheets("Table 2 (2)").Select
    Sheets("Table 2 (2)").Name = "MASTER"
    Cells.Select
    Selection.Delete Shift:=xlUp
    Range("A1").Select

Dim ActRng As Range
Dim ActWsName As String
Dim ActAddress As String
Dim Ws As Worksheet
On Error Resume Next
Set ActRng = Application.ActiveCell
ActWsName = Application.ActiveSheet.Name
ActAddress = ActRng.Address(False, False)
Application.ScreenUpdating = False
xIndex = 0
For Each Ws In Application.Worksheets
If Ws.Name <> ActWsName Then
ActRng.Offset(xIndex, 0).Value = "='" & Ws.Name & "'!" & ActAddress
xIndex = xIndex + 1
End If
Next
Application.ScreenUpdating = True

    Columns("A:A").Select
    Selection.Copy
    Columns("B:B").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("A:A").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft

    Cells.Select
    Range("B2").Activate
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With


Dim sht As Worksheet
Dim fndList As Variant
Dim rplcList As Variant
Dim x As Long

fndList = Array("To:         ")
rplcList = Array("")

    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="1", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
        1), Array(6, 1)), TrailingMinusNumbers:=True
    Columns("B:B").Select
    Selection.ClearContents

'Loop through each item in Array lists
  For x = LBound(fndList) To UBound(fndList)
    'Loop through each worksheet in ActiveWorkbook
      For Each sht In ActiveWorkbook.Worksheets
        sht.Cells.Replace What:=fndList(x), Replacement:=rplcList(x), _
          LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
          SearchFormat:=False, ReplaceFormat:=False
      Next sht
   Next x


'Loop through each item in Array lists
  For x = LBound(fndList) To UBound(fndList)
    'Loop through each worksheet in ActiveWorkbook
      For Each sht In ActiveWorkbook.Worksheets
        sht.Cells.Replace What:=fndList(x), Replacement:=rplcList(x), _
          LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
          SearchFormat:=False, ReplaceFormat:=False
      Next sht
   Next x

    Range("C1").Select
    ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-2],"" "",RC[-1],"".pdf"")"
    Range("C1:C600").Select
    Selection.FillDown
    Columns("C:C").EntireColumn.AutoFit

    Range("D1").Select
    ActiveCell.FormulaR1C1 = "=""""""""&RC[-1]&"""""""""
    Range("D1:D800").Select
    Selection.FillDown
    
    Columns("D:D").Select
    Selection.Copy
    Columns("E:E").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Columns("C:D").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft

    Columns("C:C").EntireColumn.AutoFit

    Range("E1").Select
    ActiveCell.FormulaR1C1 = "=CONCATENATE(""ren "",RC[-1], "" "",RC[-2])"
    Range("E2").Select
    Columns("E:E").EntireColumn.AutoFit
    Range("E1").Select
    Range("E1:E800").Select
    Selection.FillDown
    Columns("E:E").EntireColumn.AutoFit

    Columns("D:D").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "=""""""""&RC[-1]&"""""""""
    Range("E1:E600").Select
    Selection.FillDown

    Columns("F:F").Select
    Selection.ColumnWidth = 80
    Columns("D:D").Select


    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

    Columns("A:A").EntireColumn.AutoFit
    Columns("A:A").Select
    
    
    Selection.Replace What:="9*", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="8*", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="7*", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="6*", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="5*", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="4*", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="3*", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="2*", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="1*", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="PO*", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="Date                                                   Home Phone                                             Work Phone*", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="Vice President Approval Signature or designee           Date*", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="P.O.*", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="p.o.*", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="Po Box*", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="Instructor*", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="" & Chr(10) & "", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
        
Columns("A").SpecialCells(xlBlanks).EntireRow.Delete

Range(Range("A1"), Range("A1").End(xlDown)).Select

Dim Rng As Range
Set Rng = Selection
For Each Cell In Rng
Cell.Value = Trim(Cell)
Next Cell

Columns("A:A").EntireColumn.AutoFit
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlTop
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With

Dim Rnge As Range
Dim WorkRnge As Range
On Error Resume Next

Set WorkRnge = Application.Selection
Application.ScreenUpdating = False
Do
    Set Rnge = WorkRnge.Find("0", LookIn:=xlValues)
    If Not Rnge Is Nothing Then
        Rnge.EntireRow.Delete
    End If
Loop While Not Rnge Is Nothing
Application.ScreenUpdating = True

Dim lastRowA As Long
lastRowA = Cells(Rows.Count, "A").End(xlUp).Row
Range("A1:A" & lastRowA).Select
Range("A1:A" & lastRowA).Copy

   
SrcWbk.Sheets("MASTER").Range("A1:A" & lastRowA).Copy DestWbk.Sheets("MASTER").Range("A3")

  
   SrcWbk.Close False

End Sub
 
Upvote 0
The code does close the file at the end, so that should be good except in the case of runtime errors. There is also some macro recorder bloat in here that could be cleaned up but that is not causing your problem.

I will try to take a more detailed look. Based on your description of what you are experiencing I can't think of another obvious thing to look for.
 
Upvote 0
I don't have any other ideas, hopefully someone else will drop in. I have seen that kind of thing happen if I am opening a new instance of Excel, opening the file in that, and then neglect to close the file. It's not obvious the file is still open but it is. But that is not what you are doing.

The other thing that can happen is that Office will get confused and think a file is open when it's really not, but that would happen regardless of whether you are invoking the macro directly or by a button click.

So I'm stumped for now.
 
Upvote 0
You must log in or register to reply here.

Similar threads

WildBurrow
  • Solved
Tweaking Finding Next Empty Row Based on Column other than 'A'
Replies
5
Views
459
Joe4
Joe4
C
  • Solved
VBA to search for table from PDF File and copy and paste to Worksheet
Replies
4
Views
453
Alex Blakenburg
A
P
  • Solved
VBA to open file using Cell for the path
Replies
4
Views
581
Peter Davison
P
D
  • Solved
Save multiple sheets in a new workbook
Replies
4
Views
281
Dave_george
D
S
  • Question
Accumulate Data from 10k+ Files. Very Slow. Issue with ActiveWorkbook.Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row
2
Replies
10
Views
646
NdNoviceHlp
NdNoviceHlp

Forum statistics

Threads
1,214,857
Messages
6,121,948
Members
449,056
Latest member
FreeCricketId

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top