How do I determine which is active workbook with multiple workbooks open?

Karen Schaefer
Karen Schaefer used Ask the Experts™
on
Looking for the correct syntax to verify if workbook and worksheet are active and if so continue to process code accordingly.

        Set mybook = ThisWorkbook.Sheets
            Set mybook = Workbooks.Open(MyPath & MyFiles(FNum), UpdateLinks:=2)

My code runs three functions and the 1st function opens the workbook, so in different portion of the code needs to validate if the workbook is active.  Note I will always have another workbook (Master) open to execute the code that opens multiple files for update 1 at a time.

How do I determine which is active workbook with multiple workbooks open?
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Top Expert 2016

Commented:
HI,

pls try

MsgBox "The name of the active workbook is " & ActiveWorkbook.Name

Open in new window

Regards
ActiveWorkbook.Name gives you  the name of the workbook that is on TOP
Roy CoxGroup Finance Manager

Commented:
The newly opened workbook will always be the ActiveWorkBook, unless you activate a different workbook after opening. In your code you set a variable MyBook which is the newly opened workbook. Use that variable to refer to that workbook, you do not need ActiveWorkBook that way

   Set mybook = Workbooks.Open(MyPath & MyFiles(FNum), UpdateLinks:=2)
MyBook.Sheet1.Range("A1").value="Hello World"

Open in new window

Angular Fundamentals

Learn the fundamentals of Angular 2, a JavaScript framework for developing dynamic single page applications.

Karen SchaeferBI ANALYST

Author

Commented:
see line 102 - I need to make sure I am modifying the correct workbook/worksheet.  the "UpdateResPlan" function opens the original workbook based on directory.  Then I need this code process the update active workbook.

Public Function MergeMultipleSheets()
    Dim MyPath As String, FilesInPath As String
    Dim MyFiles() As String
    Dim SourceRcount As Long, FNum As Long
    Dim mybook As Workbook, wbMaster As Workbook
    Dim BaseWks As Worksheet, ws As Worksheet
    Dim sourceRange As Range, destrange As Range
    Dim rnum As Long, CalcMode As Long
    Dim rng As Range, SearchValue As String
    Dim FilterField As Integer, RangeAddress As String
    Dim ShName As Variant, ShNames As Variant, RwCount As Long
    Dim nFilter As String

    'Application.EnableCancelKey = xlDisabled
    
    '****************************************************************************************************************************
    'Calls function to update ResPlan in active workbook
    'Executes Updating of the ResPlan data to proper format for extraction of data in correct format
    '****************************************************************************************************************************
    Call UpdateResPlan
    
    MyPath = ThisWorkbook.Sheets("Data Input").Range("B1")
    
    '****************************************************************************************************************************
    ' Fill in the name of the sheet containing the data.
    ' Use ShName = "Sheet Name" to use a sheet name instead if its
    ' index. This example uses the index of the first sheet in
    ' every workbook.
    '****************************************************************************************************************************
 
    ShNames = Array("ProjSum", "ResPlan_data", "FinSum", "CommSum", "InvPlan")
    'ShNames = Array("FinSum")

    '****************************************************************************************************************************
    'Merge data into existing worksheets in this workbook
    '****************************************************************************************************************************
 
    Set wbMaster = ActiveWorkbook
        ' Add a slash after MyPath if needed.
    If Right(MyPath, 1) <> "\" Then
        MyPath = MyPath & "\"
    End If
    
    '****************************************************************************************************************************
    ' check for possible missing files, if there are no Excel files in the folder, exit.
    '****************************************************************************************************************************
    FilesInPath = Dir(MyPath & "*.xls*")
    If FilesInPath = "" Then
        MsgBox "No files found"
        Exit Function
    End If
    '****************************************************************************************************************************
    ' Fill the myFiles array with the list of Excel files in the folder.
    ' If there are no Excel files in the folder, exit.
    '****************************************************************************************************************************
    FNum = 0
    Do While FilesInPath <> ""
        FNum = FNum + 1
        ReDim Preserve MyFiles(1 To FNum)
        MyFiles(FNum) = FilesInPath
        FilesInPath = Dir()
    Loop
        '****************************************************************************************************************************
        ' Added Filter function - current may not be needed
        '
        '    nFilter = ThisWorkbook.Sheets("Data Input").Range("B2")
        '    If nFilter = "" And FilesInPath <> "" Then
        '            MsgBox "No files found"
        '        Exit Function
        '    Else
        '        FilesInPath = Dir(MyPath & nFilter & "*.xl*")
        '        Debug.Print FilesInPath
        '    End If
    '****************************************************************************************************************************
    ' Change application properties.
    '****************************************************************************************************************************
    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    '****************************************************************************************************************************
    ' Clear data from summary worksheets
    '****************************************************************************************************************************
    For Each ShName In ShNames
        Set rng = Nothing
    On Error Resume Next
        Set rng = wbMaster.Worksheets(ShName).UsedRange
    On Error GoTo 0
        If Not rng Is Nothing Then
            'Don't delete header labels in the first row
            Set rng = rng.Offset(1, 0)
            rng.ClearContents
        End If
    Next

    rnum = 1
    '****************************************************************************************************************************
    ' Loop through all files in the myFiles array.
    '****************************************************************************************************************************
    If FNum > 0 Then
        For FNum = LBound(MyFiles) To UBound(MyFiles)
            Set mybook = Nothing
            'Set wbMaster = ThisWorkbook
        On Error Resume Next
'            Set mybook = Workbooks.Open(MyPath & MyFiles(FNum), UpdateLinks:=2)
'            For Each mybook In Application.Workbooks
'                mybook.Activate
'            Next
'            'wbMaster.Activate

            On Error GoTo 0

            If Not mybook Is Nothing Then

                For Each ShName In ShNames
                    Set ws = Nothing
                    On Error Resume Next
                    Set ws = mybook.Worksheets(ShName)
                    On Error GoTo 0
                   
                    If Not ws Is Nothing Then
                        Set BaseWks = wbMaster.Worksheets(ShName)
                        
                        Set sourceRange = ws.UsedRange
                        
                        'Exclude header labels
                        Set rng = sourceRange.Offset(1, 0).Resize(sourceRange.Rows.Count - 1, sourceRange.Columns.Count)
                        
                        RwCount = rng.Rows.Count
                        rnum = BaseWks.Cells(BaseWks.Rows.Count, 1).End(xlUp).Row + 1
        
                        BaseWks.Cells(rnum, "A").Resize(RwCount).Value _
                              = mybook.Name
                        BaseWks.Cells(rnum, "B").Resize(RwCount, rng.Columns.Count).Value = rng.Value
                    End If
    
                Next
    '****************************************************************************************************************************
                ' Close the workbook without saving.
    '****************************************************************************************************************************
                mybook.Close SaveChanges:=False
            End If

    '****************************************************************************************************************************
            ' Open the next workbook.
    '****************************************************************************************************************************
        Next FNum

        ' Set the column width in the new workbook.
        BaseWks.Columns.AutoFit
        MsgBox "Look at the merge results after you click on OK."
    End If
    '****************************************************************************************************************************
    ' Restore the application properties.
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = CalcMode
    End With
    '****************************************************************************************************************************
 
End Function

Open in new window

Group Finance Manager
Commented:
Your code below opens a workbook. I do not see the point of looping through workbooks.

The code I posted is based on yours have you tested that?

   Set mybook = Workbooks.Open(MyPath & MyFiles(FNum), UpdateLinks:=2)

'            For Each mybook In Application.Workbooks
'                mybook.Activate
'            Next

Open in new window

Karen SchaeferBI ANALYST

Author

Commented:
thanks for the assistance
Roy CoxGroup Finance Manager

Commented:
Glad to help

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial