Solved

Excel VBA - ADO -  Updating Information on multiple tabs from a separate workbook

Posted on 2013-07-02
6
272 Views
Last Modified: 2014-05-23
Hi Guys,

Ok, The code here is in a workbook on open module. Basically this workbook is one multiple users have a copy of, when they open it it deletes a series of tabs from itself then goes away (Assuming the user has configured it if not it asks that they do configure it) and copies down the latest update versions of those tabs from a 'master' document as it were.

When it downloads these tabs, hyperlinks in these tabs break, so the code goes and copies a text version of the hyperlink from a hidden cell and rebuilds the hyperlinks.

This is all to help with the issue of multiple users accessing a single source of data and editing it.

The way I'm doing this is incredibly inefficient. Both the copying down of updated Tabs and the links rebuilding etc, its very time consuming, slows everything right down. Especially as this is redone several times whilest the user is working on the workbook, basically if they want to make a change to a row of data (A detailed record of a documents history) it goes away and updates everything again first to ensure they have the latest data and no one has updated it while they were working.

On another question early today Rorya showed me the benefits of ADO for getting data from a seperate workbook rather than opening it and copying data out. Is there a way I can speed up and streamline what I'm trying to do here using ADO to run queries to get the data instead of manually copying across the updated tabs constantly?




        ThisWorkbook.Activate
        If SheetExists("WIP") Then
        Set wsSheet2 = Sheets("Wip")
        Application.DisplayAlerts = False
        wsSheet2.Delete
        Application.DisplayAlerts = False
        Else
        End If
    
        If SheetExists("Release") Then
        Set wsSheet2 = Sheets("Release")
        Application.DisplayAlerts = False
        wsSheet2.Delete
        Application.DisplayAlerts = False
        Else
        End If
        
        If SheetExists("Index Codes") Then
        Set wsSheet2 = Sheets("Index Codes")
        Application.DisplayAlerts = False
        wsSheet2.Delete
        Application.DisplayAlerts = False
        Else
        End If
        
        If SheetExists("Document Routing") Then
        Set wsSheet2 = Sheets("Document Routing")
        Application.DisplayAlerts = False
        wsSheet2.Delete
        Application.DisplayAlerts = False
        Else
        End If



DDM = "Project Document Distribution List.xlsm"
sMyPathX = Sheets("Configuration Tab").Range("B4").Text
sPassX = Sheets("Configuration Tab").Range("B3").Text
sContacts = Sheets("Configuration Tab").Range("B5").Text


' Skip this out for internmal use (Setting file paths)
GoTo NextPlace
If sMyPathX = "" Then
MsgBox ("Please run configuration tool before attempting to use.")
Exit Sub
Else
End If

If sContacts = "" Then
MsgBox ("Please run configuration tool before attempting to use.")
Exit Sub
Else
End If

NextPlace:

 
 
If Workbooks("Project Document Distribution List.xlsm") Is Nothing Then 'Not open
Workbooks.Open Filename:=sMyPathX & DDM
Else
End If


Workbooks("Project Document Distribution List.xlsm").Sheets("Index codes").Copy After:=ThisWorkbook.Sheets("Configuration Tab")
Workbooks("Project Document Distribution List.xlsm").Sheets("WIP").Copy After:=ThisWorkbook.Sheets("Index codes")
Workbooks("Project Document Distribution List.xlsm").Sheets("Release").Copy After:=ThisWorkbook.Sheets("WIP")
Workbooks("Project Document Distribution List.xlsm").Sheets("Document Routing").Copy After:=ThisWorkbook.Sheets("Release")

' Server Config upload
Workbooks("Project Document Distribution List.xlsm").Sheets("Configuration Tab").Range("B7").Value = ThisWorkbook.Sheets("Configuration Tab").Range("B7").Value
Workbooks("Project Document Distribution List.xlsm").Sheets("Configuration Tab").Range("B6").Value = ThisWorkbook.Sheets("Configuration Tab").Range("B6").Value
Workbooks("Project Document Distribution List.xlsm").Sheets("Configuration Tab").Range("B5").Value = ThisWorkbook.Sheets("Configuration Tab").Range("B5").Value
Workbooks("Project Document Distribution List.xlsm").Sheets("Configuration Tab").Range("B4").Value = ThisWorkbook.Sheets("Configuration Tab").Range("B4").Value

' Email Config upload
Workbooks("Project Document Distribution List.xlsm").Sheets("Configuration Tab").Range("E3").Value = ThisWorkbook.Sheets("Configuration Tab").Range("E3").Value
Workbooks("Project Document Distribution List.xlsm").Sheets("Configuration Tab").Range("E4").Value = ThisWorkbook.Sheets("Configuration Tab").Range("E4").Value
Workbooks("Project Document Distribution List.xlsm").Sheets("Configuration Tab").Range("E5").Value = ThisWorkbook.Sheets("Configuration Tab").Range("E5").Value
Workbooks("Project Document Distribution List.xlsm").Sheets("Configuration Tab").Range("E7").Value = ThisWorkbook.Sheets("Configuration Tab").Range("E7").Value
Workbooks("Project Document Distribution List.xlsm").Sheets("Configuration Tab").Range("E9").Value = ThisWorkbook.Sheets("Configuration Tab").Range("E9").Value
Workbooks("Project Document Distribution List.xlsm").Sheets("Configuration Tab").Range("E10").Value = ThisWorkbook.Sheets("Configuration Tab").Range("E10").Value

' Section Headers Config Download
Sheets("Configuration Tab").Select
    Dim ii As Integer, x  As Integer
    Range("C:C").Select
    Set RangeToSearch = Selection
    Set FoundCell = RangeToSearch.Find("End of Headers")
    If Not FoundCell Is Nothing Then
        ii = RangeToSearch.Find("End Of Headers").Row
    End If
    x = 2
Do
ThisWorkbook.Sheets("Configuration Tab").Range("C" & x).Value = Workbooks("Project Document Distribution List.xlsm").Sheets("Configuration Tab").Range("C" & x).Value
x = x + 1
Loop While x <= ii


Workbooks(DDM).Save
Workbooks(DDM).Close False

ThisWorkbook.Activate


' Fix Copied links
Flag2 = 0
loopF:

If Flag2 = 0 Then
Sheets("WIP").Activate
Else
Sheets("Release").Activate
End If


Dim lRowX As Integer
lRow = 11

lRowX = ActiveSheet.UsedRange.Rows.Count

Do

sLink1 = Range("E" & lRow).Value
Range("A" & lRow).Select
    If sLink1 = "" Then
    Else
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
        sLink1 _
        , TextToDisplay:="Open Document"
    End If
lRow = lRow + 1

Loop Until lRow > lRowX

If Flag2 = 0 Then
Flag2 = 1
GoTo loopF:
Else
End If


Application.ScreenUpdating = True

End0x:


Sheets("Release").Activate
Range("D11").Select
Sheets("WIP").Activate
Range("D11").Select
Sheets("Control Tab").Activate

Application.ScreenUpdating = True

End Sub

Open in new window

0
Comment
Question by:Conor_Newman
  • 2
  • 2
6 Comments
 
LVL 85

Accepted Solution

by:
Rory Archibald earned 500 total points
ID: 39292791
If you have a master source file you probably don't really even need code. You can simply set up queries on each sheet to the master file that refresh when the workbook opens. If and when you need to refresh them subsequently, a simple Activeworkbook.Refreshall command should do the trick.
0
 
LVL 2

Author Comment

by:Conor_Newman
ID: 39292853
The worksheets can get quite big, I'd have huge amounts of formula's on multiple sheets and the amount of data changes all the time, a worksheet may start with only 20 rows of data, but as a project gets bigger that could go up to 1000+ rows of data, with blank rows, Header rows, sub headers rows being inserted at various intervals.

Not sure how well that would work, if someone had auto refresh on in their excel, a simple change could 3/4 minutes for them.. If I understand what you mean correctly? Like a

Cell A1 being = =('D:\XXXXo\YY-AA-DD\[XXXX.xlsm]WIP'!$A$1)  ?
0
 
LVL 85

Expert Comment

by:Rory Archibald
ID: 39292933
I'm not talking about formula links - I'm talking about an external query (basically what ADO does) which you can set up using Microsoft Query on the Data tab (click the From other sources drop down).
0
 
LVL 2

Author Comment

by:Conor_Newman
ID: 39293039
ok, I've never used it before, will take a look, not sure how it works or if it will do what I want.  The workbook, when configured allows users to select from a combobox listing many different projects (The combobox query you helped me with earlier) depending on what they select in there, the system then retrieves the data from the master file associated with that specific projects.

So the data source would change all the time, and the system currently accesses a log of projects to keep itself up to date with new ones being created.
0

Featured Post

How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

Join & Write a Comment

This tutorial explains how to create a series of drop-down lists that are dependent upon prior selections to guide (“force”) the user to make the correct selection and reduce data errors within Microsoft Excel. Excel 2010 was used for this tutorial;…
Outlook Free & Paid Tools
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

708 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now