VBA To Close Workbook Based On Cell Value Change And Open New Workbook

**mrprofit** · 04-10-2014, 07:51 PM

I use validation dropdown list to open some subworkbooks from this Main workbook “Main.xls”, i only need one subworkbook opened, if user opening a new subworkbook, the one that is already opened should be closed, what is the codes for this event? thanks for any help

Code:

Sub Open_Doc()

     Application.ScreenUpdating = False

     Workbooks.Open Filename _
        :=Sheets("Sheet1").Range("B2").Value & Sheets("Sheet1").Range("C2").Value

     Workbooks("Main.xls").Activate
    
     Application.ScreenUpdating = True

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C2")) Is Nothing Then
    Select Case Range("C2")
        Case "Doc_01.xls": Open_Doc
        Case "Doc_02.xls": Open_Doc
        Case "Doc_03.xls": Open_Doc
        Case "Doc_04.xls": Open_Doc
        Case "Doc_05.xls": Open_Doc
    End Select
End If
End Sub

**Excel Fox** · 04-10-2014, 08:19 PM

Try this

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Address(0, 0) = "C2" Then
        Select Case Range("C2")
            Case "Doc_01.xls", "Doc_02.xls", "Doc_03.xls", "Doc_04.xls", "Doc_05.xls"
                Open_Doc
            Case Else
                'Do something / nothing
        End Select
    End If
    
End Sub


Sub Open_Doc()

    Dim var As Variant
    Dim wbk As Workbook
    
    Application.ScreenUpdating = False
    For Each var In Array("Doc_01.xls", "Doc_02.xls", "Doc_03.xls", "Doc_04.xls", "Doc_05.xls")
        On Error Resume Next
        Set wbk = Workbooks(CStr(var))
        Err.Clear: On Error GoTo 0: On Error GoTo -1
        If Not wbk Is Nothing Then
            wbk.Close True 'Use True/False to save changes or not
            Set wbk = Nothing
        End If
    Next var
    Workbooks.Open Sheets("Sheet1").Range("B2").Value & Sheets("Sheet1").Range("C2").Value
    Workbooks("Main.xls").Activate
    Application.ScreenUpdating = True

End Sub

**mrprofit** · 04-10-2014, 08:42 PM

possible to change this line to a range where I list all the WB names in, Range(“E1:E150”)

Code:

   For Each var In Array("Doc_01.xls", "Doc_02.xls", "Doc_03.xls", "Doc_04.xls", "Doc_05.xls")

and
Sheet1("B2") = C:\My Docs\
Sheet1("C2") = DataWB.xls

how to change the

Code:

Case "Doc_01.xls", "Doc_02.xls", "Doc_03.xls", "Doc_04.xls", "Doc_05.xls"

into something simple like, as i may have 100+ data WB,

Code:

Case "Sheets("Sheet1").Range("C2").Value": Open Doc

**Excel Fox** · 04-10-2014, 09:59 PM

Try this

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Address(0, 0) = "C2" Then
        Select Case InStr(1, "|" & Join(Application.Transpose(Range("E1:E150").Value2), "|") & "|", "|" & Range("C2").Value2 & "|") > 0
            Case True
                Open_Doc
            Case Else
                'Do something / nothing
        End Select
    End If
    
End Sub


Sub Open_Doc()

    Dim var As Variant
    Dim wbk As Workbook
    Dim varWbkList As Variant
    
    varWbkList = Application.Transpose(Range("E1:E150").Value2)
    Application.ScreenUpdating = False
    For Each var In varWbkList
        On Error Resume Next
        Set wbk = Workbooks(CStr(var))
        Err.Clear: On Error GoTo 0: On Error GoTo -1
        If Not wbk Is Nothing Then
            wbk.Close True 'Use True/False to save changes or not
            Set wbk = Nothing
        End If
    Next var
    Workbooks.Open Sheets("Sheet1").Range("B2").Value & Sheets("Sheet1").Range("C2").Value
    Workbooks("Main.xls").Activate
    Application.ScreenUpdating = True

End Sub