Need VBA code for open workbook - If already open, then activate

Haahr87

New Member
Joined
Aug 30, 2018
Messages
3
Hi all,


I am completely new here.
I have looked over the forum and I have found posts, that related to what I am looking for assistance with.
However I cannot get the solutions to work for me.
Question:
I have the below VBA code and it works a charm - It could probably be simpler, but it works for my need, so it is all good.
I do however meet an issue. When the user already have the "Trykktape NO" workbook open, the user is asked, if they want t reopen it.
I am looking for a piece of code that will:
- Open the workbook "Tykktape NO"
- If the workbook is already open, then activate it
- Then runs the rest of my code
I know this is probably the simplest thing, but I cannot figure this out for the life of me.
Can anyone assist with a piece of code, that I can simply copy into my own?
Thank you very much in advance.

Best Regards
Jonas

Code:
Sub CopyAndPasteData2()
    Dim wbk As Workbook
    
    'strFirstFile = "C:\Users\andejon\Desktop\New ordersheet.xlsm"
    strSecondFile = "Q:\Operations\Customer Service\Order handling\Trykktape NO.xlsm"
    
    Sheets("Calculations").Range("H3:L3").Copy
         
    Set wbk = Workbooks.Open(strSecondFile)
    With wbk.Sheets("Trykktape Norge")
        Dim BlankRow As Long
        BlankRow = Range("A65536").End(xlUp).Row + 1
        Cells(BlankRow, 1).Select
        ActiveCell.Value = Date
        ActiveCell.Offset(0, 1).Select
        ActiveCell.Value = "New"
        ActiveCell.Offset(0, 1).Select
        ActiveCell.PasteSpecial xlPasteValues
        ActiveCell.Offset(0, 5).Select
        ActiveCell.Value = "Afventer proof"
        ActiveCell.Offset(0, 1).Select
        ActiveCell.Value = "Afventer LogoTape"
        ActiveCell.Offset(0, 1).Select
        ActiveCell.Value = "Sendt " & Date
        ActiveCell.Offset(0, -7).Select
    End With
    
    Workbooks("Trykktape NO").Save
    'Workbooks("Trycktape överblik - SE").Close
        
    Workbooks("New ordersheet.xlsm").Activate
    Application.Dialogs(xlDialogSendMail).Show Range("Calculations!E2"), Range("Calculations!E6")
        
End Sub
 

gallen

Well-known Member
Joined
Jun 27, 2011
Messages
1,931
Hello and welcome.

You just need to attempt to set wbk to the file. If it isn't open you will get an error, which tells you it needs opening. This code will achieve it.

Not tested though so let me know if you hit any snags

Code:
Sub CopyAndPasteData2()
    Dim wbk As Workbook
    Dim strFileName As String, strFilePath As String
    
    
    'strFirstFile = "C:\Users\andejon\Desktop\New ordersheet.xlsm"
    strFilePath = "Q:\Operations\Customer Service\Order handling\"
    strFileName = "Trykktape NO.xlsm"
    strsecondFile = strFilePath & strFileName
    
    Sheets("Calculations").Range("H3:L3").Copy
    
    'ignore errors
    On Error Resume Next
    'attempt to set the variable to an open workbook.
    Set wbk = Workbooks(strFileName)
    'If wbk is nothing then the previous line failed so workbook isn't open
    If wbk Is Nothing Then
        Set wbk = Workbooks.Open(strsecondFile) 'open file
    End If
    'if wbk is still nothing then it doesn't exist
    If wbk Is Nothing Then
        MsgBox strsecondFile & " not found", vbCritical, "Not Found"
        Exit Sub
    End If
    'Don't ignore errors
    On Error GoTo 0
    


    
    With wbk.Sheets("Trykktape Norge")
        Dim BlankRow As Long
        BlankRow = Range("A65536").End(xlUp).Row + 1
        Cells(BlankRow, 1).Select
        ActiveCell.Value = Date
        ActiveCell.Offset(0, 1).Select
        ActiveCell.Value = "New"
        ActiveCell.Offset(0, 1).Select
        ActiveCell.PasteSpecial xlPasteValues
        ActiveCell.Offset(0, 5).Select
        ActiveCell.Value = "Afventer proof"
        ActiveCell.Offset(0, 1).Select
        ActiveCell.Value = "Afventer LogoTape"
        ActiveCell.Offset(0, 1).Select
        ActiveCell.Value = "Sendt " & Date
        ActiveCell.Offset(0, -7).Select
    End With
    
    Workbooks("Trykktape NO").Save
    'Workbooks("Trycktape överblik - SE").Close
        
    Workbooks("New ordersheet.xlsm").Activate
    Application.Dialogs(xlDialogSendMail).Show Range("Calculations!E2"), Range("Calculations!E6")
        
End Sub
 

Haahr87

New Member
Joined
Aug 30, 2018
Messages
3
Hi Gallen,,

Thank you for the very quick reply - It worked a charm! :)

Follow-up question:
The workbook is shared, so multiple users can work in it at the same time.
Therefore the process would be to save the sheet, before entering any date (to make sure you have the latest version).
I tried to enter: "Workbooks("Trykktape NO").Save" in the next line after the "On Error Goto 0" - But then I got an error.
Should I do something differently?

Best Regards
Jonas
 

gallen

Well-known Member
Joined
Jun 27, 2011
Messages
1,931
Maybe lost in translation but you can't have multiple users working on a workbook at the same time. They can view it (read only) but only one person can make changes at any one time.

With regards to saving you have a variable - wbk so you'd just use
Code:
wbk.save
, that said your code is missing the file extension so should read
Code:
[COLOR=#333333]Workbooks("Trykktape NO[/COLOR][COLOR=#ff0000].xlsm[/COLOR][COLOR=#333333]").Save[/COLOR]
or even
Code:
[COLOR=#333333]Workbooks(strFileName[/COLOR][COLOR=#333333]).Save[/COLOR]
 
Last edited:

Haahr87

New Member
Joined
Aug 30, 2018
Messages
3
Hi again,

Where do I enter the "wbk.save"
I have tried to enter it after "On Error GoTo 0" and before "With wbk.Sheets("Trykktape Norge")

But I get this error:
Run-time error '1004':
Application-defined or object-defined error

Code:
Sub CopyAndPasteData3()
    Dim wbk As Workbook
    Dim strFileName As String, strFilePath As String
    
    
    'strFirstFile = "C:\Users\andejon\Desktop\New ordersheet.xlsm"
    strFilePath = "Q:\Operations\Customer Service\Order handling\"
    strFileName = "Trykktape NO.xlsm"
    strsecondFile = strFilePath & strFileName
    
    Sheets("Calculations").Range("H3:L3").Copy
    
    'ignore errors
    On Error Resume Next
    'attempt to set the variable to an open workbook.
    Set wbk = Workbooks(strFileName)
    'If wbk is nothing then the previous line failed so workbook isn't open
    If wbk Is Nothing Then
        Set wbk = Workbooks.Open(strsecondFile) 'open file
    End If
    'if wbk is still nothing then it doesn't exist
    If wbk Is Nothing Then
        MsgBox strsecondFile & " not found", vbCritical, "Not Found"
        Exit Sub
    End If
    'Don't ignore errors
    On Error GoTo 0
    
    
    wbk.Save
    With wbk.Sheets("Trykktape Norge")
        Dim BlankRow As Long
        BlankRow = Range("A65536").End(xlUp).Row + 1
        Cells(BlankRow, 1).Select
        ActiveCell.Value = Date
        ActiveCell.Offset(0, 1).Select
        ActiveCell.Value = "New"
        ActiveCell.Offset(0, 1).Select
        ActiveCell.PasteSpecial xlPasteValues
        ActiveCell.Offset(0, 5).Select
        ActiveCell.Value = "Afventer proof"
        ActiveCell.Offset(0, 1).Select
        ActiveCell.Value = "Afventer LogoTape"
        ActiveCell.Offset(0, 1).Select
        ActiveCell.Value = "Sendt " & Date
        ActiveCell.Offset(0, -7).Select
    End With
    
    Workbooks("Trykktape NO.xlsm").Save
    'Workbooks("Trycktape överblik - SE").Close
        
    Workbooks("New ordersheet.xlsm").Activate
    Application.Dialogs(xlDialogSendMail).Show Range("Calculations!E2"), Range("Calculations!E6")
        
End Sub
 

gallen

Well-known Member
Joined
Jun 27, 2011
Messages
1,931
I've tested setting wbk to an open file, and saving and have no issue. Only issue I can see is if it is somehow read-only? But then it would just ask you to save with different name.

It won't get to wbk.Save unless wbk is set so I'm a little confused. Maybe someone else can see the error?
 

Forum statistics

Threads
1,081,617
Messages
5,360,044
Members
400,565
Latest member
Tommy O

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top