If file is not open go to next

Question

From multiple workbooks I copy info into one Workbook. This works like a charm. I just got informed that in a few weeks I'll have to add another file to copy data from. I wanted to get the Macro going now but if I don't have the new workbook open the macro gets stuck. I have tried a few different ways but I don't get it to work. I have the same code going with the other 3 workbooks, so when this comes I want the macro to skip it if Workbook is not open. Any suggestions?

Windows("filename.xlsx").Activate
Range(Range("A2:K2"), Range("A2:K2").End(xlDown)).Copy
Workbooks("Masterfile.xlsm").Sheets("Electra").Activate
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

Possible duplicate of [Detect whether Excel workbook is already open](https://stackoverflow.com/questions/9373082/detect-whether-excel-workbook-is-already-open) — danieltakeshi, Sep 27 '17 at 13:27
Thanx! Am I thinking this wrong? I was thinking to check with - If workbook "Filename" is not open go to next. I don't want to get a message, just want Macro to keep on running :) — Sture, Sep 27 '17 at 13:39
I'd step through the workbooks collection (a collection of workbooks that are open in the application) and check if the name is in a list of file names that need looking at- if it is then copy/paste the info. If `Masterfile` is the file that your code is in you can refer to it using `ThisWorkbook`. — Darren Bartrup-Cook, Sep 27 '17 at 13:41
@danieltakeshi Would that code you point to indicate if the workbook is open by someone else, in which case you wouldn't be able to copy from it as you may not have it open - someone else does. — Darren Bartrup-Cook, Sep 27 '17 at 13:44
What i understood is that the OP wants the status of the workbook open, if is not open (which is status `False`) just skip this code. `I want the macro to skip it if Workbook is not open` — danieltakeshi, Sep 27 '17 at 13:47
I understood it as the OP needs the workbook open in their Excel so they can copy data out of it - `if I don't have the new workbook open` — Darren Bartrup-Cook, Sep 27 '17 at 13:49
I will be the only one having these workbooks open so that's safe.@danieltakeshi you are right, if is not open skip this part of the code. I'll try working with Status False and see what happens. — Sture, Sep 27 '17 at 14:01

Darren Bartrup-Cook · Answer 1 · 2017-10-05T08:35:28.940

This code will step through the workbooks that you have open and check against a list of file names that you need.

There's a couple of problems that could occur:

Your workbook must have a sheet called Sheet1 as the code doesn't check for this.

If you have a file called book1.xlsm and 1book1.xlsm. book1.xlsm occurs in both.

Finding the last cell in columns A:K could be improved. Currently it will go from A2 to the last row containing data in column K.

All information will be pasted starting at cell A2. You need code to find the last row on the Electra sheet as well.

Sub Test() 

    Dim sFileNames As String
    Dim wrkBk As Workbook

    sFileNames = "Somebook.xls, book1.xlsm, book2.xlsx"

    For Each wrkBk In Workbooks
        If InStr(UCase(sFileNames), UCase(wrkBk.Name)) > 0 Then
            With wrkBk.Worksheets("Sheet1")
                .Range(.Cells(2, 1), .Cells(.Rows.Count, 11).End(xlUp)).Copy
                ThisWorkbook.Worksheets("Electra").Range("A2").PasteSpecial xlPasteValues
            End With
        End If
    Next wrkBk  

End Sub

Edit:
To paste to different sheets in the MasterFile one option is to use a dictionary to hold workbook & destination sheet pairings.

This code will add the file names as keys and the destination sheets as values. It then checks if the workbook name exists within the dictionary, if it does it copies the data from Sheet1 and pastes the values into relevant sheet.

Sub Test()

    Dim dict As Object
    Dim wrkBk As Workbook
    Set dict = CreateObject("Scripting.Dictionary")

    dict.CompareMode = vbTextCompare
    dict.Add "Book2.xlsx", "Sheet1"
    dict.Add "Book3.xlsx", "Sheet2"

    For Each wrkBk In Workbooks
        If dict.exists(wrkBk.Name) Then
            With wrkBk.Worksheets("Sheet1")
                .Range(.Cells(2, 1), .Cells(.Rows.Count, 11).End(xlUp)).Copy
                ThisWorkbook.Worksheets(dict(wrkBk.Name)).Range("A2").PasteSpecial xlPasteValues
            End With
        End If
    Next wrkBk

End Sub

Edit 2:
If the source workbooks are all closed at the start then use this code to open the relevant files, copy the info and close the file again.

Sub Test()

    Dim dict As Object
    Dim wrkBk As Workbook
    Dim vItem As Variant
    Dim sPath As String

    'All workbooks to open will be in this folder.
    'Remember to include the final back-slash (\).
    sPath = "C:\Test\"

    Set dict = CreateObject("Scripting.Dictionary")

    dict.CompareMode = vbTextCompare

    'If files will not all be in the same folder, then
    'full file path must be included here and remove
    'references to sPath variable in the code.
    dict.Add "Book2.xlsx", "Sheet1"
    dict.Add "Book3.xlsx", "Sheet2"

    For Each vItem In dict
        Set wrkBk = Workbooks.Open(sPath & vItem)
        With wrkBk.Worksheets("Sheet1")
            .Range(.Cells(2, 1), .Cells(.Rows.Count, 11).End(xlUp)).Copy
            ThisWorkbook.Worksheets(dict(wrkBk.Name)).Range("A2").PasteSpecial xlPasteValues
        End With
        wrkBk.Close SaveChanges:=False
    Next vItem

End Sub

I copy from each file into separate sheets in Masterfile. then I have other macro matching data into another sheet and creating a report. S I do not think that one will work. Sorry for not telling you this. — Sture, Sep 27 '17 at 14:20
That's ok, I'm used to it.... It will work as far as checking the other workbook is open by you, you just need a mechanism for saying _this file to this sheet_. — Darren Bartrup-Cook, Sep 27 '17 at 14:26
Found a simple way with OnErrorGoTo Have not used that one before so learnt something new :) — Sture, Sep 28 '17 at 12:56
Glad you found a way. I'd stay away from using On Errors for anything other than trapping unhandled errors, but as long as it works for you. — Darren Bartrup-Cook, Sep 28 '17 at 13:03
It could hide other problems in your code. For example: your code may successfully activate the right workbook, it may copy the correct range, but for one file the cells may be merged and when you try and paste an error occurs - the code won't let you know this, it will just treat it as though you couldn't reference the file and move onto the next file. Saying that though - there are times when you do just ignore errors. :) — Darren Bartrup-Cook, Sep 29 '17 at 16:24
Would it be a better idea do divide this into separate subs like: Sub1 Window Electra copy etc etc, call sub 2 end sub, Sub 2 Window Telecom copy etc etc, call sub 3, end sub, Sub 3 window Data copy etc etc. Do you understand how I think? — Sture, Oct 05 '17 at 08:22
No. Each procedure would contain pretty much the same code - the only thing you'd be changing is the file name and the destination sheet. I'd have just the workbook containing the code open at the start. Let the code open the workbook, copy the data and close it again - I'll update my answer to include that option. — Darren Bartrup-Cook, Oct 05 '17 at 08:32
Ok thanks! I got this question right now from the person who will use this process later on. " If I have two of the files that contain data available one day and run this macro. can I just continue another day when I get the other two-three datafiles?" I have not managed do do this in a good way without having to open all files. would your solution work that way? — Sture, Oct 05 '17 at 08:54
It will open the workbooks listed in the `dict.Add` code and will throw an error if any of those files don't exist. You could test if the file exists before attempting to open it using code similar to the answer in this link: https://stackoverflow.com/questions/16351249/vba-check-if-file-exists (`Len(Dir("C:\Test\Book2.xlsm")) <> 0`. To avoid copy the same data twice you could move the file to an archive folder after it's been used using code found in this link: https://www.rondebruin.nl/win/s3/win026.htm — Darren Bartrup-Cook, Oct 05 '17 at 09:07

score 0 · Answer 2 · answered Oct 05 '17 at 09:12

This is maybee the most good looking but it actually worked, I never done Call before so I just had to try. I can run this multiple time with different books open and it don't bug out or mess things up. As faar as two test are made. Sub Steg11() ' ' Steg1 Macro

' Macrot flyttar data från CDPPT fil med försäljningsdata, ' från fil med Electras försäljning och fil med produktdata. ' Kopierar formler, rensar försäljning till Lagerhållare

Dim MainWkbk As Workbook
Dim NextWkbk As Workbook
Set MainWkbk = ActiveWorkbook
Set NextWkbk = ActiveWorkbook

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

' Letar in CDPPT, lägger in formler, sorterar bladet.
On Error GoTo 3
Windows("CDPPT.xlsx").Activate
Range(Range("A2"), Range("A2").End(xlToRight).End(xlDown)).Copy
Workbooks("Datamatchningsfil.xlsm").Sheets("CDPPT").Activate
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

Sheets("CDPPT").Select
Range(Range("I2"), Range("I2").End(xlToRight)).Copy
Range("H2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Offset(1, 0).Select
ActiveSheet.Paste

Application.Goto Sheets("CDPPT").Range("A:M")
Selection.Sort Key1:=Range("E1"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal


'Tar bort data där telia inte ska betala skatt
Application.Goto Sheets("CDPPT").Range("E1")
ActiveSheet.Range("$A:$M").AutoFilter Field:=5, Criteria1:="=*BRIGHTSTAR*" _
    , Operator:=xlAnd
ActiveCell.Offset(1, 0).Activate
Range(Selection, Selection.End(xlDown)).Select
Selection.EntireRow.Delete
ActiveSheet.ShowAllData
ActiveWorkbook.RefreshAll
ActiveSheet.Range("$A:$M").AutoFilter Field:=5, Criteria1:="=*ELECTRA*" _
    , Operator:=xlAnd
ActiveWindow.SmallScroll Down:=-6
ActiveCell.Offset(1, 0).Activate
Range(Selection, Selection.End(xlDown)).Select
Selection.EntireRow.Delete
ActiveSheet.ShowAllData
ActiveWorkbook.RefreshAll
ActiveSheet.Range("$A:$M").AutoFilter Field:=5, Criteria1:="=*Ingram*" _
    , Operator:=xlAnd
ActiveWindow.SmallScroll Down:=-9
ActiveCell.Offset(1, 0).Activate
Range(Selection, Selection.End(xlDown)).Select
Selection.EntireRow.Delete
ActiveSheet.ShowAllData
ActiveWorkbook.RefreshAll
ActiveSheet.Range("$A:$M").AutoFilter Field:=3, Criteria1:="=*brev*" _
    , Operator:=xlAnd
ActiveCell.Offset(1, 0).Activate
Range(Selection, Selection.End(xlDown)).Select
Selection.EntireRow.Delete
ActiveSheet.ShowAllData
ActiveWorkbook.RefreshAll
ActiveSheet.Range("$A:$M").AutoFilter Field:=3, Criteria1:="=*Konfig*" _
    , Operator:=xlAnd
ActiveCell.Offset(1, 0).Activate
Range(Selection, Selection.End(xlDown)).Select
Selection.EntireRow.Delete
ActiveSheet.ShowAllData
ActiveWorkbook.RefreshAll
ActiveSheet.Range("$A:$M").AutoFilter Field:=5, Criteria1:="=*(Manuellt 
inmatad)*" _
    , Operator:=xlAnd
ActiveCell.Offset(1, 0).Activate
Range(Selection, Selection.End(xlDown)).Select
Selection.EntireRow.Delete
ActiveSheet.ShowAllData
ActiveWorkbook.RefreshAll

3
Call Produktdata
End Sub

Sub Produktdata()

'Letar in produktdata
On Error GoTo 4
Windows("Produktdata.xlsx").Activate
If ActiveSheet.AutoFilterMode Then Cells.AutoFilter
Range(Range("A:J"), Range("A:J").End(xlDown)).Copy
Workbooks("Datamatchningsfil.xlsm").Sheets("Produktdata").Activate
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
4
Call Electra
End Sub

Sub Electra()
'Letar in data från Lagerhållare
On Error GoTo 5
Windows("Electra sales.xlsx").Activate
Range(Range("A2:K2"), Range("A2:K2").End(xlDown)).Copy
Workbooks("Datamatchningsfil.xlsm").Sheets("Electra").Activate
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
5
Call TalkTelecom
End Sub

Sub TalkTelecom()

'Letar in data från Lagerhållare
On Error GoTo 6
Windows("TalkTelecom.xlsx").Activate
Range(Range("A2:K2"), Range("A2:K2").End(xlDown)).Copy
Workbooks("Datamatchningsfil.xlsm").Sheets("TalkTelecom").Activate
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
6
Call Techdata
End Sub

Sub Techdata()
'Letar in data från Lagerhållare
On Error GoTo 7
Windows("TechData.xlsx").Activate
Range(Range("A2:K2"), Range("A2:K2").End(xlDown)).Copy
Workbooks("Datamatchningsfil.xlsm").Sheets("TechData").Activate
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
7
Call Continue
End Sub

Sub Continue()

' Utför text till kolumn
Application.Goto Sheets("Produktdata").Range("C:C")
Columns("C:C").Select
Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
    :=Array(1, 1), TrailingMinusNumbers:=True

Application.Goto Sheets("CDPPT").Range("F:F")
Columns("F:F").Select
Selection.TextToColumns Destination:=Range("F1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
    :=Array(1, 1), TrailingMinusNumbers:=True

Application.Calculation = xlCalculationAutomatic
ActiveWorkbook.RefreshAll

'Lägger in år och månad i blad arbetsbeskrivning
Application.Goto Sheets("CDPPT").Range("G2")
Range("G2").Copy
Sheets("Arbetsbeskrivning").Select
Range("C10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("D10").Activate
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=RIGHT(RC[-1],2)"
Range("D10").Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("D10").Select
Selection.TextToColumns Destination:=Range("D10"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
    :=Array(1, 1), TrailingMinusNumbers:=True
Range("D9").Activate
ActiveCell.FormulaR1C1 = "=VLOOKUP(R[1]C,Datalistor!R[-6]C[1]:R[5]C[2],2,0)"
Range("C9").Activate
ActiveCell.FormulaR1C1 = "=Left(R[1]C,4)"
Range("C4").Activate


' kopierar data och skapar Pivotdata Telia försäljning
Sheets("CDPPT").Select
Range(Range("A2"), Range("A2").End(xlToRight).End(xlDown)).Copy 
Destination:=Sheets("Matchning"). _
    Range("A2")
Application.CutCopyMode = False
Sheets("CDPPT").Select
Range(Range("A2"), Range("A2").End(xlToRight).End(xlDown)).Copy 
Destination:=Sheets("Pivotgrund"). _
    Range("A2")
Application.CutCopyMode = False

ActiveWorkbook.RefreshAll

' Tar bort dubletter
Application.Goto Sheets("Matchning").Range("A:M")
Selection.Sort Key1:=Range("F1"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Application.Goto Sheets("Matchning").Range("A1")
Range(Range("A1"), Range("A1").End(xlToRight).End(xlDown)).Select
ActiveSheet.Range("A:L").RemoveDuplicates Columns:=6, Header:= _
    xlYes

ActiveWorkbook.RefreshAll

' letar in Pivotdata
Application.Goto Sheets("Matchning").Range("H2")
ActiveCell.FormulaR1C1 = "=VLOOKUP(C[-2],Pivot!C[-7]:C[-6],2,0)"
Range("H2").Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste

ActiveWorkbook.RefreshAll

' Skapar fil med prod med saknad data
Application.Goto Sheets("Matchning").Range("A1")
Range("A1").Select
ActiveSheet.Range("$A:P").AutoFilter Field:=12, Criteria1:= _
    "Check for data"
Range(Range("A1"), Range("A1").End(xlToRight).End(xlDown)).Copy
Range("A1").Select
Workbooks.Add
ActiveSheet.Paste
ActiveWorkbook.Windows(1).Caption = "Produktdata saknas"
Columns("M:P").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select

Windows("Datamatchningsfil.xlsm").Activate
Application.Goto Sheets("Matchning").Range("A1")
ActiveSheet.ShowAllData


ActiveWorkbook.RefreshAll
Application.ScreenUpdating = True

Sheets("Arbetsbeskrivning").Select
Range("C13").Select
With Selection.Font
    .Color = -16776961
    .TintAndShade = 0
End With
Selection.Font.Bold = True
ActiveCell.FormulaR1C1 = _
    "Steg 1 klart!"
Range("C14").Select


Application.DisplayStatusBar = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

MsgBox ("Steg 1 klart")

End Sub

If file is not open go to next

2 Answers2