Linking

  • Thread starter Thread starter kev
  • Start date Start date
K

kev

Hi folks,

This might be an easy one but it has been bugging me for hours already.
I have a workbook (seri.xls) with 6 worksheets namely:
Frontpage,Input,PartsData,LookupLists,PivotTable,MsiaChart.

I have created two links from my website which will open the respective
worksheet
view blabla link to PartsData worksheet
view status link to MsiaChart worksheet
(but i dun prefer this method as users can unhide other sheets in the
same workbook)

Is there a way i can create two separate workbook one for PartsData
worksheet in workbook A and one for MsiaChart worksheet in workbook B.
Thus i can link"
view blabla link to PartsData worksheet in workbook A
view status link to MsiaChart worksheet in workbook B.

My second question is by doing this method does it ensure that the main
workbook (seri.xls) always will auto update data into workbook A and
B.How can i do this?

please help.Thanks.
 
Hi, Kev. I actually do this myself so that folks have a "report" workbook
that shows what they need without accessing the raw data. This is fairly
easy, actually.

Take your PartsData sheet and right-click the tab name. Select "Move or
Copy", select "New Workbook" from the drop down box, and check the box to
"Create a copy". Same thing with the chart.

Now on the new PartsData workbook, highlight A1 to the end of all your data
and type this formula (click on seri.xls/PartsData where I put <click>:
=IF(<click>A1<>"",<click>A1,"") and hit Ctrl+Enter. This tells the new
workbook to just find the value for each cell from the original workbook on
a real-time basis, and testing for blanks will prevent those from carrying
over as zeroes. Since you copied the original worksheet, the original
formatting will remain intact. While new headings will carry over to the
new workbook, new formatting will not. If that ever becomes a need, just
highlight the entire original worksheet and use the format painter to update
the separate workbook.

Now protect your new workbooks from being changed and you're done. Link to
the new files instead of the old one.

- KC
 
Hi KC,

This method does not seem to work as i put in a new record in seri.xls
and it does not update in the new workbook for PartsData. btw, A1 in
the formula refers to the cell A1 in the seri.xls workbook rite?any
other suggestions?Please help as i am running out of time.

Thanks.
 
I'm not sure this is what you are after.
the macro below will copy PartsData sheet to WorkbookA and MsiaChart sheet
to WorkbookB respectively, then save those workbooks into directory
"C:\tmp".
Copy the code below to your standard module in your seri.xls and run it.

Sub extractsheet()
Dim arr, Linkco
Dim acbook As Workbook, wktmp As Workbook
Dim distdir As String
Dim i As Long, j As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False
ActiveWorkbook.Save

'Change those names in array below -
' to your name of workbook and sheet
arr = Array(Array("WorkbookA.xls", "PartsData"), _
Array("WorkbookB.xls", "MsiaChart"))
distdir = "C:\tmp" '<=== Change this to your path name

On Error GoTo errhandler
ChDir distdir
Set acbook = ActiveWorkbook
Application.SheetsInNewWorkbook = 1
For i = 0 To UBound(arr)
Set wktmp = Workbooks.Add
For j = 1 To UBound(arr(i))
acbook.Sheets(arr(i)(j)).Copy _
before:=wktmp.Sheets(1)
Next
wktmp.Sheets(wktmp.Sheets.Count).Delete
Linkco = wktmp.LinkSources _
(Type:=xlLinkTypeExcelLinks)
If Not IsEmpty(Linkco) Then
For j = 1 To UBound(Linkco)
wktmp.BreakLink _
Name:=Linkco(j), _
Type:=xlLinkTypeExcelLinks
Next
End If
wktmp.SaveAs Filename:=arr(i)(0)
wktmp.Close
Next
Exit Sub
errhandler:
If Err.Number = 9 Then
MsgBox "Sheet's name " & arr(i)(1) & _
" is not found"
ElseIf Err.Number = 76 Then
MsgBox "Can't find path " & distdir
Else
MsgBox "Unkown error"
End If
wktmp.Close
End Sub

Or you can put the code like below into ThisWorkbook module in your
seri.xls, then it would update WorkbookA and WorkbookB automatically when
you close seri.xls.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
extractsheet
End Sub

keizi
 
I think you've got the principle of it down, you just need to extend your
formulas down as many rows as you think you'll need. Go ahead and drag the
formula down 20,000 rows if you have to, as they are not actually requiring
any "calculation" and should not slow Excel down one bit. Then as you add
more data to the original, the new worksheet will show the new data in real
time.
Yes, if you call your new worksheet PartsDataReport, then cell A1 on that
sheet ='[seri.xls]PartsData'!A1, then that formula is dragged across your
columns and then down as far as you want.
 
Hi kounoike,

That worked so wonderful. Thanks so much.
Just one tiny problem, whenever it extracts it does not protect the
sheet.I have set it as protect sheet earlier on but when any new data
is added and it extracts again it does not protect the sheet making it
vulnerable for changes by users, pls help... i m in d process of
closing this project already just waiting for your reply.
 
Hi kev

i don't know whether this is enough or not for your requirement. i modified
the code a little only to protect each sheets in each workbook with the
"same" password. but i think this one is also vulnerable because the
password reside in the code.

Sub extractsheet()
Dim arr, Linkco
Dim acbook As Workbook, wktmp As Workbook
Dim distdir As String
Dim i As Long, j As Long
Const pword = "1234" '<==change password

Application.ScreenUpdating = False
Application.DisplayAlerts = False
ActiveWorkbook.Save

'Change those names in array below -
' to your name of workbook and sheet
arr = Array(Array("WorkbookA.xls", "PartsData"), _
Array("WorkbookB.xls", "MsiaChart"))
distdir = "C:\tmp" '<=== Change this to your path name

On Error GoTo errhandler
ChDir distdir
Set acbook = ActiveWorkbook
Application.SheetsInNewWorkbook = 1
For i = 0 To UBound(arr)
Set wktmp = Workbooks.Add
For j = 1 To UBound(arr(i))
acbook.Sheets(arr(i)(j)).Unprotect Password:=pword
acbook.Sheets(arr(i)(j)).Copy _
before:=wktmp.Sheets(1)
acbook.Sheets(arr(i)(j)).Protect Password:=pword, _
DrawingObjects:=True, Contents:=True, Scenarios:=True
Next
wktmp.Sheets(wktmp.Sheets.Count).Delete
Linkco = wktmp.LinkSources _
(Type:=xlLinkTypeExcelLinks)
If Not IsEmpty(Linkco) Then
For j = 1 To UBound(Linkco)
wktmp.BreakLink _
Name:=Linkco(j), _
Type:=xlLinkTypeExcelLinks
Next
End If
For j = 1 To wktmp.Sheets.Count
wktmp.Sheets(j).Protect Password:=pword, _
DrawingObjects:=True, Contents:=True, Scenarios:=True
Next
wktmp.SaveAs Filename:=arr(i)(0)
wktmp.Close
Next
Exit Sub
errhandler:
If Err.Number = 9 Then
MsgBox "Sheet's name " & arr(i)(1) & _
" is not found"
ElseIf Err.Number = 76 Then
MsgBox "Can't find path " & distdir
Else
MsgBox "Unkown error"
End If
wktmp.Close
End Sub

keizi
 
Back
Top