Open up workbooks and run the code in theworkbooks.

[Bagsy]

I hope somebody wouldn’t mind just helping me a bit here as I am stuck. I have some excel documents in a folder all named as a unique 5 digit number which I have created. Each of these excel documents has a button on them which runs a macro “TransferToWIPAndSort” . This transfers data from the open file to a file called WIP.

I am building some code which I hope will open each of these files in the folder, run the embedded code and then close the file. I have the code working until I reach the point of running the embedded code which I can’t get to work.



Any help is appreciated

I have tried the following lines of code

    'Application.Run "myfileTransferToWIPAndSort"
    Application.Run "'myfile.xlsm'!TransferToWIPAndSort"
    'Call TransferToWIPAndSort

Main code

Sub AllFiles()
   Dim i As Long
   Dim Ws As Worksheet
   Dim Wkbk As Workbook
   'Dim myfile As Workbook
   Dim sht As Worksheet

  
    
myDir = "W:\Sub-Contract\Test"
'myDir = "W:\1works managers files\Cost sheets\Cost sheets test"
 'myDir = "W:\1works managers files\Cost sheets"
myfile = Dir(myDir & Application.PathSeparator & "*.xlsm", vbDirectory)

With Application
  .DisplayAlerts = False
  .ScreenUpdating = False
End With

Set Ws = Worksheets("Sheet1")
Ws.Range("B3:E500").ClearContents 'Clear Data in Column B3 to E500
i = 3 ' this is starting a Row 1 then offsetting to row 3


Do While myfile <> ""
    If myfile <> "WIP.XLSX" Then Workbooks.Open filename:=myDir & "\" & myfile, UpdateLinks:=False
            Ws.Cells(i, 2) = myfile ' this is offsetting from column A to column B
        Set Wkbk = Workbooks.Open(myDir & "\" & myfile, False) ' the false on the end prevents update links and opens read only
    Sheets("Cost Sheet").Select ' select the sheet cost sheet on the opened excel file then run the code in this workbook

                
    'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
    'Application.Run "myfileTransferToWIPAndSort"
    Application.Run "'myfile.xlsm'!TransferToWIPAndSort"
    'Call TransferToWIPAndSort
    'Call a subroutine here to run on the just-opened workbook
    'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
    
                Wkbk.Close False
            myfile = Dir
        i = i + 1
    Loop
    
With Application
  .DisplayAlerts = True
  .ScreenUpdating = True
End With
End Sub

 

[starl]

Why not have the TransferToWIPAndSort code in the workbook you're using to automate all 5 workbooks? You can use arguments to send that code the correct workbook(s) to deal with.

 

[Bagsy]

Hi Starl

Thanks for your help

I can put the code “TransferToWIPAndSort” in the workbook that I am trying to run the code from, in fact I tried it and couldn’t get it to work either, same problem couldn't call the code and run it.

What I am trying to achieve is open up a folder in which there are around 300 files which are in fact cost sheets, open each of these cost sheets in turn then run the code from these sheets (in effect press the update WIP button on these sheets).
What the “TransferToWIPAndSort” code does is simply check to see if this work order has already been entered if so searches for it and copies information from the cost sheets updates that line on the WIP file, if it hasn't been copied before it enters the work order as new and then copies the data onto the WIP & sorts in order A-Z .
I would like to be able to run this code I am trying to get to work at the end of each month to ensure that the WIP is completely up to date, sometimes people forget to press the update WIP button on the cost sheet.

Code embeded on the cost sheet below.

Sub TransferToWIPAndSort()

'This adds to the WIP and sorts in order A-Z

'Transfering the hours & costs incurred at present time to the WIP File

Dim WB As Workbook

Dim CurrentSheet As Worksheet

Set CurrentSheet = ActiveSheet

Set Wkbk = ActiveWorkbook

Dim x As String

Dim found As Boolean


If Range("D5") = "" Then

        MsgBox "You must enter a job Number"

    Range("D5").Select

Exit Sub

End If


Application.ScreenUpdating = False ' turn off the screen updating

Call CheckIfOpen 'checking if the WIP file is in use

 On Error GoTo ErrorHandler

    Sheets("Cost Sheet").Select

        Range("AF7:AH7").Copy

            x = Sheets("Cost Sheet").Range("D5").Value   ' Set search variable value.

                    Set WB = Workbooks.Open(Filename:=Sheets("Cost Sheet").Range("AJ5").Text & ".xlsx")

                        WB.Activate

                            Sheets("Sheet1").Select

                    Range("B5").Select 'select the first line of data

            found = False ' Set Boolean variable "found" to false.

        Do Until IsEmpty(ActiveCell) ' Set Do loop to stop at empty cell.

If ActiveCell.Value = x Then ' Check active cell for search value.

found = True

Exit Do

End If


ActiveCell.Offset(1, 0).Select ' Step down 1 row from present location.

    Loop

        If found = True Then ' Check for found.

            ActiveCell.Offset(0, 1).Select

                ActiveCell.PasteSpecial Paste:=xlValues

            MsgBox "Data Copied to WIP " '& ActiveCell.Address

        Else

'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

'this is entering the T number if it does not exist

    

ActiveCell.Select 'selecting the first emnpty cell

    ActiveCell = x 'putting in the number from cost sheet D5

        ActiveCell.Offset(0, 1).Select 'selecting column C to paste the values in

            ActiveCell.PasteSpecial Paste:=xlValues

        ActiveCell.Offset(0, 3).Select ' selecting column F to put the sum formula in

    ActiveCell.FormulaR1C1 = "=SUM(RC[-3]+RC[-2])" 'entering the sum formula

    

     Range("B4").Select 'select the header row in WIP file to sort A-Z

  Range("B4", Range("F4").End(xlDown)).Sort Key1:=Range("B4"), Order1:=xlAscending, Header:=xlYes 'sorting A-Z

    

MsgBox "Data Copied to WIP " '& ActiveCell.Address

    

'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

    

End If

Application.CutCopyMode = False

Wkbk.Activate

Sheets("Cost Sheet").Select

WB.Close True ' close the WIP saving any changes

Set WB = Nothing ' free memory

Application.ScreenUpdating = True ' turn on the screen updating

Exit Sub


ErrorHandler: MsgBox ("There Is An Error, data not entered."), , "NO DATA ENTERED"

End Sub

 

[starl]

If the code is the same in all the workbooks, best practice is to have it in one workbook. Though, I suppose if you ever have to run it manually in the specific workbook, it would be a reason to have a separate copy.. but what a nightmare to update! For my clients, I would recommend the single program workbook with two buttons - 1 to run an entire folder, the other 2 run a specific workbook.

But if for some reason that's not an option for you..

 Application.Run "'" & wkbk.Name & "'!TransferToWIPAndSort"

the code your calling should be in a standard module.
If that's not working, you should step through the code and see what it does when it gets to that line.

 

[Bagsy]

Hi Starl

Thank you for that that works perfectly, I was nearly there with

Application.Run "'myfile.xlsm'!TransferToWIPAndSort"

The reason there is code on all the sheets, these cost sheets are created from a template as new jobs are received. Then they are updated as working hours and costs are added which in turn updates the wip, Once the job has been completed the completed cost sheets are moved to another folder.

One last question, if you don't mind
How do I prevent the Msgbox “WIP updated” from opening up as I run the code. I have looked on this forum and below do not work for message boxes

With Application
  .DisplayAlerts = False
  .ScreenUpdating = False
  .EnableEvents = False

I did find an example on how to bypass this by changing the code I am calling as below. This I know is not ideal as there are many files, but if I at least change the template, eventually it will filter through.
Anyway this didn’t seem to work I must have missed something

Sub TransferToWIPAndSort(Optional UserInteract As Boolean = True)

    If UserInteract Then ' this is looking to see if this has been done Manually
MsgBox "Data Copied to WIP " '& ActiveCell.Address

Full code with changes

Sub TransferToWIPAndSort(Optional UserInteract As Boolean = True) ' the instruction in the bracket is to see if there has been user interaction so when i run update all cost sheets I dont keep getting the message box "WIP Updated"
'This adds to the WIP and sorts in order A-Z
'Transfering the hours & costs incurred at present time to the WIP File
Dim WB As Workbook
Dim CurrentSheet As Worksheet
Set CurrentSheet = ActiveSheet
Set Wkbk = ActiveWorkbook
Dim x As String
Dim found As Boolean

If Range("D5") = "" Then
        MsgBox "You must enter a job Number"
    Range("D5").Select
Exit Sub
End If

Application.ScreenUpdating = False ' turn off the screen updating
Call CheckIfOpen 'checking if the WIP file is in use
 On Error GoTo ErrorHandler
    Sheets("Cost Sheet").Select
        Range("AF7:AH7").Copy
            x = Sheets("Cost Sheet").Range("D5").Value   ' Set search variable value.
                    Set WB = Workbooks.Open(Filename:=Sheets("Cost Sheet").Range("AJ5").Text & ".xlsx")
                        WB.Activate
                            Sheets("Sheet1").Select
                    Range("B5").Select 'select the first line of data
            found = False ' Set Boolean variable "found" to false.
        Do Until IsEmpty(ActiveCell) ' Set Do loop to stop at empty cell.
If ActiveCell.Value = x Then ' Check active cell for search value.
found = True
Exit Do
End If

ActiveCell.Offset(1, 0).Select ' Step down 1 row from present location.
    Loop
        If found = True Then ' Check for found.
            ActiveCell.Offset(0, 1).Select
                ActiveCell.PasteSpecial Paste:=xlValues
                  If UserInteract Then ' this is looking to see if this has been done Manually
            MsgBox "Data Copied to WIP " '& ActiveCell.Address
        Else
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'this is entering the T number if it does not exist
    
ActiveCell.Select 'selecting the first emnpty cell
    ActiveCell = x 'putting in the number from cost sheet D5
        ActiveCell.Offset(0, 1).Select 'selecting column C to paste the values in
            ActiveCell.PasteSpecial Paste:=xlValues
        ActiveCell.Offset(0, 3).Select ' selecting column F to put the sum formula in
    ActiveCell.FormulaR1C1 = "=SUM(RC[-3]+RC[-2])" 'entering the sum formula
    
     Range("B4").Select 'select the header row in WIP file to sort A-Z
        Range("B4", Range("F4").End(xlDown)).Sort Key1:=Range("B4"), Order1:=xlAscending, Header:=xlYes 'sorting A-Z
    If UserInteract Then ' this is looking to see if this has been done Manually
MsgBox "Data Copied to WIP " '& ActiveCell.Address
    
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
    
End If
End If
End If
Application.CutCopyMode = False
Wkbk.Activate
Sheets("Cost Sheet").Select
WB.Close True ' close the WIP saving any changes
Set WB = Nothing ' free memory
Application.ScreenUpdating = True ' turn on the screen updating
Exit Sub

ErrorHandler: MsgBox ("There Is An Error, data not entered."), , "NO DATA ENTERED"

End Sub

 

[Bagsy]

Hi Starl
I think I have it figured if I change the “TransferToWIPAndSort” code on the original cost sheet template where the code with the message box is, from

MsgBox "Data Copied to WIP " '& ActiveCell.Address

To

If Application.DisplayAlerts Then MsgBox "Data Copied to WIP " '& ActiveCell.Address

Then use Application.DisplayAlerts = False on the code I am running to open up these cost sheets, this seems to solve the problem.
Thank you so much for your help

 

[starl]

Yeah, you can do it that way if it works. I usually use an argument because there may be several bits of code I want to run differently.