Run a macro in background

Excelquestion35

Board Regular
Joined
Nov 29, 2021
Messages
53
Office Version
  1. 2016
Platform
  1. Windows
Hi all,

Thought this question would have been raised in the past but can't find the similar situation I am looking for.

At the moment I have two separate macro's that I want to combine. One of the macros retrieves data from one workbook and replaces the data in another workbook.
The macro should be triggered when someone filled in a form in Excel and presses a macro button.

However, the person who is filling in the form and submits it using the trigger button has at least one of the workbooks not open.
How can I deal with the situation that it still managers to update the workbook that is closed?

Many thanks!
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
you can open the closed file (condition it's not in use by another person), update, save and close again.
What is the macro you use now with an opened 2nd workbook ?
 
Upvote 0
Hi BSALV, thank you for your reply! The idea is that the person who submits the form does not have access to the file. This file will be stored somewhere on a share drive.

The macro that is now built inside the workbook that should be edited in the background is the following:
VBA Code:
Sub Vervangentekst()
    Dim src As Worksheet
    Dim tgt As Worksheet
    Dim filterRange As Range, PasteRange As Range
    Dim copyRange As Range
    Dim lastRow As Long
    Dim customer As String
    
    Set src = Workbooks("Copy of Site overview (003) - 2.xlsm").Sheets("FLMs")
    Set tgt = Workbooks("Kronos Centraal Formulier v3.2 - Template (zonder check) - RPA versie.xlsm").Sheets("Supervisor (leidinggevende)")
    customer = Workbooks("Copy of Site overview (003) - 2.xlsm").Sheets("FLM-change").Range("C17")
    Set PasteRange = tgt.Range("1:1").Find(customer, , , xlWhole, , , flase, , False)

    If PasteRange Is Nothing Then
         MsgBox customer & " not found"
         Exit Sub
    End If
    PasteRange.Offset(1).Resize(1000).ClearContents
    
    src.AutoFilterMode = False
    lastRow = src.Range("C" & src.Rows.Count).End(xlUp).Row

    Set filterRange = src.Range("B3:P" & lastRow)
    Set copyRange = src.Range("C4:C" & lastRow)

   filterRange.AutoFilter field:=1, Criteria1:=customer
  
    copyRange.SpecialCells(xlCellTypeVisible).Copy PasteRange.Offset(1)
    
    src.AutoFilterMode = False

End Sub


Though, I still have the move above code and combine it with the other code:
VBA Code:
Sub Test()
inarr = ActiveSheet.Range("$B$1:$AS$66") ' load all the data into a variant array NOTE starting from row1
manager = Sheets("FLM-change").Range("C18")
site = Sheets("FLM-change").Range("C17")
newflm = Sheets("FLM-change").Range("C13")
wlmuserid = Sheets("FLM-change").Range("C10")
kronosid = Sheets("FLM-change").Range("C11")
mail = Sheets("FLM-change").Range("C12")
verandering = Sheets("FLM-change").Range("C19")

For i = 3 To 66   ' start loop at row 3
   If inarr(i, 2) = manager And inarr(i, 1) = site Then ' we have found the row
    Range(Cells(i, 2), Cells(i, 45)).Select ' do whatewver you need to do on this row
    Selection.Copy
    Selection.Insert Shift:=xlDown
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = newflm
    
 
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.Value = "=Today()"
    ActiveCell.Offset(0, 0).Range("A1").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = manager
    
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = kronosid
    
    ActiveCell.Offset(0, 3).Range("A1").Select
    ActiveCell.FormulaR1C1 = mail
    
    ActiveCell.Offset(0, 4).Range("A1").Select
    ActiveCell.FormulaR1C1 = wlmuserid
    
    ActiveCell.Offset(0, 2).Range("A1").Select
    ActiveCell.FormulaR1C1 = mail
    
        If verandering = "Verwijderen" Then ActiveCell.Offset(1, -11).Range("A1").Select
        ActiveCell.FormulaR1C1 = "No"
               
    Exit For
        
   End If
Next i
End Sub
 
Upvote 0
goeie avond,
which of this files is the closed workbook ?
- "Kronos Centraal Formulier v3.2 - Template (zonder check) - RPA versie.xlsm"
- "Copy of Site overview (003) - 2.xlsm"
I supposed "Kronos", but because you added that 2nd macro, i'm not 100% sure.
Your workbook in which you do the modifications is still another, a 3rd workbook and this 2 macros are part of that workbook ?
 
Upvote 0
Hi BSALV,

The closed workbook is indeed "Kronos Centraal Formulier v3.2 - Template (zonder check) - RPA versie.xlsm". The modifications are done now in both workbooks. The second code only adjusts the 'Site overview' workbook, while the other code uses the site overview workbook as input for changes in the 'Kronos' workbook.
 
Upvote 0
VBA Code:
Sub Vervangentekst()
     Dim src   As Worksheet
     Dim tgt   As Worksheet
     Dim filterRange As Range, PasteRange As Range
     Dim copyRange As Range
     Dim lastRow As Long
     Dim customer As String
     Dim Kronos As Workbook

     Set src = Workbooks("Copy of Site overview (003) - 2.xlsm").Sheets("FLMs")
     customer = Workbooks("Copy of Site overview (003) - 2.xlsm").Sheets("FLM-change").Range("C17")

     On Error Resume Next
     skronos = "C:\mydirectory\Kronos Centraal Formulier v3.2 - Template (zonder check) - RPA versie.xlsm"     'path en filename Kronos
     sp = Split(skronos, "\")                                   'splitten op "\"
     Set Kronos = Workbooks(sp(UBound(sp)))                     'workbook Kronos
     bclosed = (Kronos Is Nothing)                              'Kronos is niet ope
     If bclosed Then
          Set Kronos = Workbooks.Open(skronos)
          If Kronos Is Nothing Then MsgBox "kan kronos niet openen, einde verhaal": Exit Sub
     End If
     On Error GoTo 0
     Set tgt = Kronos.Sheets("Supervisor (leidinggevende)")
       Set PasteRange = tgt.Range("1:1").Find(customer, , , xlWhole, , , flase, , False)

     If PasteRange Is Nothing Then
          MsgBox customer & " not found"
     Else
          PasteRange.Offset(1).Resize(1000).ClearContents

          src.AutoFilterMode = False
          lastRow = src.Range("C" & src.Rows.Count).End(xlUp).Row

          Set filterRange = src.Range("B3:P" & lastRow)
          Set copyRange = src.Range("C4:C" & lastRow)

          filterRange.AutoFilter field:=1, Criteria1:=customer

          copyRange.SpecialCells(xlCellTypeVisible).Copy PasteRange.Offset(1)

          src.AutoFilterMode = False
     End If
     
     If bclosed Then Kronos.Close 1 'indien Kronos niet open was, sluiten met opslaan

End Sub
 
Upvote 0
Solution

Forum statistics

Threads
1,214,970
Messages
6,122,514
Members
449,088
Latest member
RandomExceller01

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