+ Reply to Thread
Results 1 to 3 of 3

Open workbooks update the main one and close the other workbooks

Hybrid View

  1. #1
    Forum Contributor stojko89's Avatar
    Join Date
    05-18-2009
    Location
    Maribor, Slovenia
    MS-Off Ver
    MS Office 365
    Posts
    913

    Open workbooks update the main one and close the other workbooks

    Hi,

    What I'm tryn to do here is ask how can I on 4 different sheet open workbooks that are hyperlinked in cells so it would open the workbook on sheet 1 update the table and close the workbook.
    And then move down to the next hyperlinked cell and update the main workbook from the opened one and close it down.
    Then move to the next sheet to the next hyperlinked cell and to do the same untill it updated all the tables on all 4 sheets for all hyperlinked cells.
    I don't know how to realy ask this...

    But I have a code that has named ranges.
    Set PO103641 = Worksheets(1).Range("D11:D32")
    Set PO103642 = Worksheets(1).Range("D34:D55")
    Set PO103643 = Worksheets(1).Range("D57:D77")
    Set PO103644 = Worksheets(1).Range("D79:D99")
    Set PO103645 = Worksheets(1).Range("D101:D121")
    Set PO103651 = Worksheets(2).Range("D11:D31")
    Set PO103681 = Worksheets(3).Range("D11:D26")
    Set PO103682 = Worksheets(3).Range("D28:D47")
    Set PO103683 = Worksheets(3).Range("D49:D68")
    Set PO103684 = Worksheets(3).Range("D70:D86")
    Set PO103685 = Worksheets(3).Range("D88:D99")
    Set PO103701 = Worksheets(4).Range("D11:D30")
    Set PO103702 = Worksheets(4).Range("D32:D47")
    Set PO103703 = Worksheets(4).Range("D49:D68")
    The hyperlinked cell is one cell above the begining of the named range.
    For example for sheet 3 Range D11:D26 the hyperlinked cell is D10
    For sheet 4 Range D32:D47 the hyperlinked cell is D31.

    The hyperlink cell is the address of where the file is on the computer/server.

    My whole code is this:
    Sub UpdateTable()
    'Update the table in Eureka-IMPRO worksheet with information from a chosen workbook
    Dim x As Range, xf As Range, NR As Range
    Dim PO103641 As Range, PO103642 As Range, PO103643 As Range, PO103644 As Range, PO103645 As Range
    Dim PO103651 As Range
    Dim PO103681 As Range, PO103682 As Range, PO103683 As Range, PO103684 As Range, PO103685 As Range
    Dim PO103701 As Range, PO103702 As Range, PO103703 As Range
    Dim sFilename As String, sPathname As String
    Dim wbOp As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    
    sPathname = "U:\Skupno\Eureka Pumps AS\"
    Set ws1 = ThisWorkbook.ActiveSheet
    Set PO103641 = Worksheets(1).Range("D11:D32")
    Set PO103642 = Worksheets(1).Range("D34:D55")
    Set PO103643 = Worksheets(1).Range("D57:D77")
    Set PO103644 = Worksheets(1).Range("D79:D99")
    Set PO103645 = Worksheets(1).Range("D101:D121")
    Set PO103651 = Worksheets(2).Range("D11:D31")
    Set PO103681 = Worksheets(3).Range("D11:D26")
    Set PO103682 = Worksheets(3).Range("D28:D47")
    Set PO103683 = Worksheets(3).Range("D49:D68")
    Set PO103684 = Worksheets(3).Range("D70:D86")
    Set PO103685 = Worksheets(3).Range("D88:D99")
    Set PO103701 = Worksheets(4).Range("D11:D30")
    Set PO103702 = Worksheets(4).Range("D32:D47")
    Set PO103703 = Worksheets(4).Range("D49:D68")
    
    If ActiveSheet.Name = Worksheets(1).Name Then GoTo PO10364
    If ActiveSheet.Name = Worksheets(2).Name Then GoTo PO10365
    If ActiveSheet.Name = Worksheets(3).Name Then GoTo PO10368
    If ActiveSheet.Name = Worksheets(4).Name Then GoTo PO10370
    
    PO10364:
    If Not Intersect(ActiveCell, PO103641) Is Nothing Then
        Set NR = PO103641
        ChDir sPathname & Range("A10").Hyperlinks(1).Address
        sFilename = Application.GetOpenFilename
            If sFilename <> "" Then
                Set wbOp = Workbooks.Open(sFilename)
            End If
        GoTo UpdatePo
    ElseIf Not Intersect(ActiveCell, PO103642) Is Nothing Then
        Set NR = PO103642
        ChDir sPathname & Range("A33").Hyperlinks(1).Address
        sFilename = Application.GetOpenFilename
            If sFilename <> "" Then
                Set wbOp = Workbooks.Open(sFilename)
            End If
        GoTo UpdatePo
    ElseIf Not Intersect(ActiveCell, PO103644) Is Nothing Then
        Set NR = PO103644
        ChDir sPathname & Range("A78").Hyperlinks(1).Address
        sFilename = Application.GetOpenFilename
            If sFilename <> "" Then
                Set wbOp = Workbooks.Open(sFilename)
            End If
        GoTo UpdatePo
    Else
        MsgBox "Za delovanje te osvežitve podatkov klikni eno celico v stolpcu - D"
        Exit Sub
    End If
    
    PO10365:
    If Not Intersect(ActiveCell, PO103651) Is Nothing Then
        Set NR = PO103651
        ChDir sPathname & Range("A10").Hyperlinks(1).Address
        sFilename = Application.GetOpenFilename
            If sFilename <> "" Then
                Set wbOp = Workbooks.Open(sFilename)
            End If
        GoTo UpdatePo
    Else
        MsgBox "Za delovanje te osvežitve podatkov klikni eno celico v stolpcu - D"
        Exit Sub
    End If
    
    PO10368:
    If Not Intersect(ActiveCell, PO103681) Is Nothing Then
        Set NR = PO103681
        ChDir sPathname & Range("A10").Hyperlinks(1).Address
        sFilename = Application.GetOpenFilename
            If sFilename <> "" Then
                Set wbOp = Workbooks.Open(sFilename)
            End If
        GoTo UpdatePo
    ElseIf Not Intersect(ActiveCell, PO103682) Is Nothing Then
        Set NR = PO103682
        ChDir sPathname & Range("A27").Hyperlinks(1).Address
        sFilename = Application.GetOpenFilename
            If sFilename <> "" Then
                Set wbOp = Workbooks.Open(sFilename)
            End If
        GoTo UpdatePo
    ElseIf Not Intersect(ActiveCell, PO103684) Is Nothing Then
        Set NR = PO103684
        ChDir sPathname & Range("A69").Hyperlinks(1).Address
        sFilename = Application.GetOpenFilename
            If sFilename <> "" Then
                Set wbOp = Workbooks.Open(sFilename)
            End If
        GoTo UpdatePo
    ElseIf Not Intersect(ActiveCell, PO103685) Is Nothing Then
        Set NR = PO103685
        ChDir sPathname & Range("A87").Hyperlinks(1).Address
        sFilename = Application.GetOpenFilename
            If sFilename <> "" Then
                Set wbOp = Workbooks.Open(sFilename)
            End If
        GoTo UpdatePo
    Else
        MsgBox "Za delovanje te osvežitve podatkov klikni eno celico v stolpcu - D"
        Exit Sub
    End If
    
    PO10370:
    If Not Intersect(ActiveCell, PO103701) Is Nothing Then
        Set NR = PO103701
        ChDir sPathname & Range("A10").Hyperlinks(1).Address
        sFilename = Application.GetOpenFilename
            If sFilename <> "" Then
                Set wbOp = Workbooks.Open(sFilename)
            End If
        GoTo UpdatePo
    ElseIf Not Intersect(ActiveCell, PO103702) Is Nothing Then
        Set NR = PO103702
        ChDir sPathname & Range("A31").Hyperlinks(1).Address
        sFilename = Application.GetOpenFilename
            If sFilename <> "" Then
                Set wbOp = Workbooks.Open(sFilename)
            End If
        GoTo UpdatePo
    ElseIf Not Intersect(ActiveCell, PO103703) Is Nothing Then
        Set NR = PO103703
        ChDir sPathname & Range("A48").Hyperlinks(1).Address
        sFilename = Application.GetOpenFilename
            If sFilename <> "" Then
                Set wbOp = Workbooks.Open(sFilename)
            End If
        GoTo UpdatePo
    Else
        MsgBox "Za delovanje te osvežitve podatkov klikni eno celico v stolpcu - D"
        Exit Sub
    End If
            
    UpdatePo:
    Set ws2 = wbOp.Sheets(1)
    For Each x In NR
    Set xf = ws2.Range("E9:E" & Range("E65536").End(xlUp).Row).Find(x.Value, Lookat:=xlWhole)
        If Not ws1.Range("J" & x.Row).Value = ws2.Range("O" & xf.Row).Value Then
            ws1.Range("J" & x.Row).Value = ws2.Range("O" & xf.Row).Value
            ws1.Range("G" & x.Row).Value = ws2.Range("A" & xf.Row).Value
            If ws1.Range("J" & x.Row).Value < "5" Or ws1.Range("J" & x.Row).Value = "V" Then
                If ws1.Range("G" & x.Row).Value = "1" Then
                    ws1.Range("H" & x.Row).Value = ws2.Range("P" & xf.Row).Value
                    ws1.Range("I" & x.Row).Value = Format(Mid(ws2.Range("P" & xf.Row).Comment.Text, 10), "d.m.yyyy")
                    ws1.Range("K" & x.Row).Value = ws2.Range("Q" & xf.Row).Value
                ElseIf ws1.Range("G" & x.Row).Value = "2" Then
                    ws1.Range("H" & x.Row).Value = ws2.Range("R" & xf.Row).Value
                    ws1.Range("I" & x.Row).Value = Format(Mid(ws2.Range("P" & xf.Row).Comment.Text, 10), "d.m.yyyy")
                    ws1.Range("K" & x.Row).Value = ws2.Range("S" & xf.Row).Value
                ElseIf ws1.Range("G" & x.Row).Value = "3" Then
                    ws1.Range("H" & x.Row).Value = ws2.Range("T" & xf.Row).Value
                    ws1.Range("I" & x.Row).Value = Format(Mid(ws2.Range("P" & xf.Row).Comment.Text, 10), "d.m.yyyy")
                    ws1.Range("K" & x.Row).Value = ws2.Range("U" & xf.Row).Value
                ElseIf ws1.Range("G" & x.Row).Value = "4" Then
                    ws1.Range("H" & x.Row).Value = ws2.Range("V" & xf.Row).Value
                    ws1.Range("I" & x.Row).Value = Format(Mid(ws2.Range("P" & xf.Row).Comment.Text, 10), "d.m.yyyy")
                    ws1.Range("K" & x.Row).Value = ws2.Range("W" & xf.Row).Value
                End If
            ElseIf ws1.Range("J" & x.Row).Value = "5" Then
                ws1.Range("I" & x.Row).Value = ""
                ws1.Range("K" & x.Row).Value = ""
                If ws1.Range("G" & x.Row).Value = "1" Then
                    ws1.Range("H" & x.Row).Value = ws2.Range("P" & xf.Row).Value
                ElseIf ws1.Range("G" & x.Row).Value = "2" Then
                    ws1.Range("H" & x.Row).Value = ws2.Range("R" & xf.Row).Value
                ElseIf ws1.Range("G" & x.Row).Value = "3" Then
                    ws1.Range("H" & x.Row).Value = ws2.Range("T" & xf.Row).Value
                ElseIf ws1.Range("G" & x.Row).Value = "4" Then
                    ws1.Range("H" & x.Row).Value = ws2.Range("V" & xf.Row).Value
                End If
            End If
        End If
    Next x
    wbOp.Close SaveChanges:=False
    End Sub
    But I'm tryn to make a code like...
    For each worksheet in Thisworkbook.worksheets
    For each POnumber
    Open workbook
    update table
    close workbook
    Next POnumber
    Next Worksheet
    MsgBox "Finito"
    Any idias?

  2. #2
    Forum Contributor stojko89's Avatar
    Join Date
    05-18-2009
    Location
    Maribor, Slovenia
    MS-Off Ver
    MS Office 365
    Posts
    913

    Re: Open workbooks update the main one and close the other workbooks

    My code works now so...
    I click on a cell in the named range.
    Hit the Update Table button.
    It opens the hyperlink and I select the workbook.
    It updates and then it closes the workbook.

    I know how to avoide the selecting of the workbook I'm tryn to figure out how to tell excel how to do it for every PO number

  3. #3
    Forum Contributor stojko89's Avatar
    Join Date
    05-18-2009
    Location
    Maribor, Slovenia
    MS-Off Ver
    MS Office 365
    Posts
    913

    Re: Open workbooks update the main one and close the other workbooks

    Never mind...

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. [SOLVED] Open Multiple Workbooks, Record names, Copy paste to Active Workbook, Close the Workbooks
    By vba_madness in forum Excel Programming / VBA / Macros
    Replies: 7
    Last Post: 01-24-2013, 06:09 AM
  2. How to close open workbooks from an application get open filename call ?
    By leanne2011 in forum Excel Programming / VBA / Macros
    Replies: 1
    Last Post: 12-10-2011, 10:41 PM
  3. Workbooks("").Close Crashes Excel With Mutiple Workbooks Open
    By exs120 in forum Excel Programming / VBA / Macros
    Replies: 4
    Last Post: 09-27-2011, 03:24 PM
  4. Close all workbooks except for the main workbook
    By Khaos176 in forum Excel Programming / VBA / Macros
    Replies: 3
    Last Post: 04-21-2009, 02:48 PM
  5. Open Close workbooks
    By bbc1 in forum Excel General
    Replies: 2
    Last Post: 08-28-2005, 07:05 AM

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1