Dear Ram,

You can try below macro with Rajan's Suggestion to reduce your file size..

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

Thanks & regards,
Noorain Ansari

On Fri, Apr 20, 2012 at 12:32 AM, ram xls <ram.excel2...@gmail.com> wrote:

> hi All,
>
> Need your expert advise in this concern . please suggest the ways to speed
> up my activity.
>
> Is there a quicker way for vlookup and pivot in Excel when the data is
> huge, like 10 lakh rows?
>
>
> Thanks,
> Ram
>
> --
> 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
>



-- 
Thanks & regards,
Noorain Ansari
 *http://noorainansari.com/* <http://excelmacroworld.blogspot.com/>
*http://excelmacroworld.blogspot.com/*<http://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

Reply via email to