Hi Noorain,
unfortunatelly it won't help, but you give me some thoughts,
Thanks you it helps
Pawel
________________________________
From: NOORAIN ANSARI <noorain.ans...@gmail.com>
To: excel-macros@googlegroups.com
Sent: Friday, July 13, 2012 10:21 AM
Subject: Re: $$Excel-Macros$$ long opening file on the external server
Hi lupinski,
Please try it once again..
Option Explicit
Sub SHRINK_EXCEL_FILE_SIZE()
Dim WSheet As Worksheet
Dim CSheet As String 'New Worksheet
Dim OSheet As String 'Old WorkSheet
Dim Col As Long
Dim ECol As Long 'Last Column
Dim lRow As Long
Dim BRow As Long 'Last Row
Dim Pic As Object
For Each WSheet In Worksheets
WSheet.Activate
'Put the sheets in a variable to make it easy to go back and forth
CSheet = WSheet.Name
'Rename the sheet to its name with _Delete at the end
OSheet = CSheet & "_Delete"
WSheet.Name = OSheet
'Add a new sheet and call it the original sheets name
Sheets.Add
ActiveSheet.Name = CSheet
Sheets(OSheet).Activate
'Find the bottom cell of data on each column and find the further row
For Col = 1 To Columns.Count 'Find the actual last bottom row
If Cells(Rows.Count, Col).End(xlUp).Row > BRow Then
BRow = Cells(Rows.Count, Col).End(xlUp).Row
End If
Next
'Find the end cell of data on each row that has data and find the
furthest one
For lRow = 1 To BRow 'Find the actual last right column
If Cells(lRow, Columns.Count).End(xlToLeft).
Column > ECol Then
ECol = Cells(lRow, Columns.Count).End(xlToLeft).Column
End If
Next
'Copy the REAL set of data
Range(Cells(1, 1), Cells(BRow, ECol)).Copy
Sheets(CSheet).Activate
'Paste Every Thing
Range("A1").PasteSpecial xlPasteAll
'Paste Column Widths
Range("A1").PasteSpecial xlPasteColumnWidths
Sheets(OSheet).Activate
For Each Pic In ActiveSheet.Pictures
Pic.Copy
Sheets(CSheet).Paste
Sheets(CSheet).Pictures(Pic.Index).Top = Pic.Top
Sheets(CSheet).Pictures(Pic.Index).Left = Pic.Left
Next Pic
Sheets(CSheet).Activate
'Reset the variable for the next sheet
BRow = 0
ECol = 0
Next WSheet
' Since, Excel will automatically replace the sheet references for you on
your formulas,
' the below part puts them back.
' This is done with a simple replace, replacing _Delete with nothing
For Each WSheet In Worksheets
WSheet.Activate
Cells.Replace "_Delete", ""
Next WSheet
'Roll through the sheets and delete the original fat sheets
For Each WSheet In Worksheets
If Not Len(Replace(WSheet.Name, "_Delete", "")) = Len(WSheet.Name) Then
Application.DisplayAlerts = False
WSheet.Delete
Application.DisplayAlerts = True
End If
Next
End Sub
Hope it will help to you.
On Fri, Jul 13, 2012 at 12:14 PM, pawel lupinski <lupins...@yahoo.com> wrote:
Hi All,
>
>I need your help on this issue. I have quite big file (21MB) that is doing a
>lot of calculation between tabs, in order to run this file more efficient I've
>switch off calculation, and I'm switch it on when needed. When I've done this
>file on my computer its opening slowly but not so bad 10 sec. The problem is:
>when I've put this file on company server for other users its a nightmare.
>Yesterday I've been waiting to open about 6-10 min!!! I've checked this on
>different workstation and the same opening time unbelievable.
>Do you have any thoughts? How Can I change this? What can improve it?
>
>Need your help
>
>Pawel
--
>FORUM RULES (986+ members already BANNED for violation)
>
>1) Use concise, accurate thread titles. Poor thread titles, like Please Help,
>Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will not get
>quick attention or may not be answered.
>
>2) Don't post a question in the thread of another member.
>
>3) Don't post questions regarding breaking or bypassing any security measure.
>
>4) Acknowledge the responses you receive, good or bad.
>
>5) Cross-promotion of, or links to, forums competitive to this forum in
>signatures are prohibited.
>
>NOTE : Don't ever post personal or confidential data in a workbook. Forum
>owners and members are not responsible for any loss.
>
>------------------------------------------------------------------------------------------------------
>To post to this group, send email to excel-macros@googlegroups.com
>
>To unsubscribe, send a blank email to
>mailto:excel-macros%2bunsubscr...@googlegroups.com
--
Thanks & regards,
Noorain Ansari
http://www.noorainansari.com/
www.excelmacroworld.blogspot.com
--
FORUM RULES (986+ members already BANNED for violation)
1) Use concise, accurate thread titles. Poor thread titles, like Please Help,
Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will not get
quick attention or may not be answered.
2) Don't post a question in the thread of another member.
3) Don't post questions regarding breaking or bypassing any security measure.
4) Acknowledge the responses you receive, good or bad.
5) Cross-promotion of, or links to, forums competitive to this forum in
signatures are prohibited.
NOTE : Don't ever post personal or confidential data in a workbook. Forum
owners and members are not responsible for any loss.
------------------------------------------------------------------------------------------------------
To post to this group, send email to excel-macros@googlegroups.com
To unsubscribe, send a blank email to excel-macros+unsubscr...@googlegroups.com
--
FORUM RULES (986+ members already BANNED for violation)
1) Use concise, accurate thread titles. Poor thread titles, like Please Help,
Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will not get
quick attention or may not be answered.
2) Don't post a question in the thread of another member.
3) Don't post questions regarding breaking or bypassing any security measure.
4) Acknowledge the responses you receive, good or bad.
5) Cross-promotion of, or links to, forums competitive to this forum in
signatures are prohibited.
NOTE : Don't ever post personal or confidential data in a workbook. Forum
owners and members are not responsible for any loss.
------------------------------------------------------------------------------------------------------
To post to this group, send email to excel-macros@googlegroups.com
To unsubscribe, send a blank email to excel-macros+unsubscr...@googlegroups.com
