Dear ASA, It was great, worked as I wanted Thanks you for help, all experts who helped in this issue
Regards, Prashant On Sun, Jun 17, 2012 at 5:57 AM, Asa Rossoff <a...@lovetour.info> wrote: > My post should work, but I made a "boo boo". The SizeColumns macro should > not have Set Workbook=Nothing at the end. Workbook was a parameter to > the procedure, and setting it to Nothing will effect whatever other > procedure called SizeColumns.**** > > ** ** > > Here is the corrected version of SizeColumns: **** > > Sub SizeColumns(Worksheet As Worksheet) > Dim _ > VisibleCellColumns As Range, _ > VisibleCellEntireColumns As Range, _ > Column As Range, _ > OriginalColumnWidths As Collection, _ > OriginalColumnWidth As Double, _ > ScreenUpdatingState As Boolean > > ' Disable screen updating (and remember existing state) > ScreenUpdatingState = Application.ScreenUpdating > Application.ScreenUpdating = False > > ' Determine VisibleCellColumns to AutoFit > Set VisibleCellColumns = > Worksheet.UsedRange.SpecialCells(xlCellTypeVisible).Columns > > ' Determine VisibleCellEntireColumns for remembering column widths > ' We use Application.Union to eliminate redundancy in the range. > Set VisibleCellEntireColumns = _ > Union( _ > VisibleCellColumns.EntireColumn, _ > VisibleCellColumns(1) _ > ).EntireColumn > > ' Save current column widths to OriginalColumnWidths collection > Set OriginalColumnWidths = New Collection > For Each Column In VisibleCellEntireColumns > OriginalColumnWidths.Add Column.ColumnWidth, CStr(Column.Column) > Next Column > > ' Autofit visible cell's columns > VisibleCellColumns.AutoFit > > ' Restore original column widths that were wider > For Each Column In VisibleCellEntireColumns > OriginalColumnWidth = OriginalColumnWidths(CStr(Column.Column)) > If Column.ColumnWidth < OriginalColumnWidth Then > Column.ColumnWidth = OriginalColumnWidth > End If > Next Column > > ' Restore ScreenUpdating state > Application.ScreenUpdating = ScreenUpdatingState > > ' Cleanup > Set Column = Nothing > Set OriginalColumnWidths = Nothing > Set VisibleCellEntireColumns = Nothing > Set VisibleCellColumns = Nothing > End Sub**** > > Asa**** > > ** ** > > *From:* excel-macros@googlegroups.com [mailto: > excel-macros@googlegroups.com] *On Behalf Of *Asa Rossoff > *Sent:* Saturday, June 16, 2012 6:43 PM > *To:* excel-macros@googlegroups.com > *Subject:* RE: $$Excel-Macros$$ Find Narrow Cells & Appying Auto fit to > only that cell**** > > ** ** > > Prashant:**** > > My guess is that your request is for a macro that will only Auto-Increase > column widths -- never decrease them, which would unneccesarily change the > look of the spreadsheet.**** > > ** ** > > Excel does not have a method of specifically identifying cells (or > columns) where text has "overflowed", but I can think of two ways to solve > the problem (if I am guessing your intent correctly):**** > > **1) **Examine the TEXT property of cells. This property indicates > the *displayed* Value. If the formatted Cell.Value fits entirely in the > cell, then Cell.Text is the formatted Cell.Value. If some of the Text is > cut off, Cell.Text = a string of "#" symbols (same as you see on the > spreadsheet). If the column is hidden, Cell.Text="" (an empty string). > It would be nice to be able to search the Text property for "#####" (or > any length string of "#", then for those matches, apply the number format > of the cell, conditional formats to the Value and compare it to the Text. > If they are different, then the text has overflowed and we can Auto-Fit > that entire column and then search for "#####" (and the like) in other > columns… There is no built-in search method that searches the Text > property, though, so we would have to examine the spreadsheet > cell-by-cell. Besides being complex, this method would miss the case of > General format numbers with some digits after the decimal hidden from view > due to a narrow column width. That case could be handled, but it would > require comparing Text and formatted Value for maybe many more cells. In > Excel 2010 we could use cell.Displayformat.Numberformat to determine the > NumberFormat used for display, considering the cell format, conditional > format, and anything else that I didn't think of.**** > > **2) **This is a simpler method! Save the column widths---perhaps > in an array. Autofit all columns. Loop through the columns and for any > columns that decreased in size, re-apply their old column width.**** > > ** ** > > I will provide a macro for method #2.**** > > ** ** > > I will assume that you want a special case for already hidden columns and > they should remain hidden. Also that cell values in hidden rows should not > effect the column width. To accommodate those special cases, I will only > apply AutoFit based on Visible cells.**** > > ** ** > > Here is the macro:**** > > Sub SizeColumns(Worksheet As Worksheet) > Dim _ > VisibleCellColumns As Range, _ > VisibleCellEntireColumns As Range, _ > Column As Range, _ > OriginalColumnWidths As Collection, _ > OriginalColumnWidth As Double, _ > ScreenUpdatingState As Boolean > > ' Disable screen updating (and remember existing state) > ScreenUpdatingState = Application.ScreenUpdating > Application.ScreenUpdating = False > > ' Determine VisibleCellColumns to AutoFit > Set VisibleCellColumns = > Worksheet.UsedRange.SpecialCells(xlCellTypeVisible).Columns > > ' Determine VisibleCellEntireColumns for remembering column widths > ' We use Application.Union to eliminate redundancy in the range. > Set VisibleCellEntireColumns = _ > Union( _ > VisibleCellColumns.EntireColumn, _ > VisibleCellColumns(1) _ > ).EntireColumn > > ' Save current column widths to OriginalColumnWidths collection > Set OriginalColumnWidths = New Collection > For Each Column In VisibleCellEntireColumns > OriginalColumnWidths.Add Column.ColumnWidth, CStr(Column.Column) > Next Column > > ' Autofit visible cell's columns > VisibleCellColumns.AutoFit > > ' Restore original column widths that were wider > For Each Column In VisibleCellEntireColumns > OriginalColumnWidth = OriginalColumnWidths(CStr(Column.Column)) > If Column.ColumnWidth < OriginalColumnWidth Then > Column.ColumnWidth = OriginalColumnWidth > End If > Next Column > > ' Restore ScreenUpdating state > Application.ScreenUpdating = ScreenUpdatingState > > ' Cleanup > Set Column = Nothing > Set OriginalColumnWidths = Nothing > Set VisibleCellEntireColumns = Nothing > Set VisibleCellColumns = Nothing > Set Worksheet = Nothing > End Sub**** > > ** ** > > If you want to have the columns sized automatically when you print the > worksheet(s), you can use the workbook's BeforePrint event.**** > > ** ** > > Here's an example Workbook.BeforePrint event procedure (place it in the > ThisWorkbook module):**** > > Private Sub Workbook_BeforePrint(Cancel As Boolean) > Dim Sheet As Worksheet > > ' SizeColumns for all of ThisWorkbook's Worksheets. > For Each Sheet In Me.Worksheets > SizeColumns Sheet > Next Sheet > > 'Cleanup > Set Sheet = Nothing > End Sub**** > > ** ** > > If you want to avoid sizing columns in every single worksheet when the > user might only be printing one of the worksheets, it's a bit trickier, > since Excel doesn't tell the macro what worksheets are currently being > printed. The user might being printed a selected range, the active > worksheet, a selection of multiple worksheets, or the entire workbook. If > printing was initiated from a macro, there are many more possibilities, > since what is being printed isn't necessarily selected.**** > > ** ** > > However, here is a solution for the most common case of the user printing > the currently selected sheet(s). In case the workbook is not the active > workbook, it will fall back to processing every single worksheet, since the > printing was probably initiated from a macro. In any case, it's probably > best to assume we don't know what is being printed.**** > > Private Sub Workbook_BeforePrint(Cancel As Boolean) > Dim _ > Window As Window, _ > Sheet As Object > > Set Window = ActiveWindow > > If Window.Parent Is Me Then > ' ActiveWindow belongs to ThisWorkbook. > ' Assume user is printing selected sheets. > For Each Sheet In Window.SelectedSheets > If TypeOf Sheet Is Worksheet Then > SizeColumns Sheet > End If > Next Sheet > > Else > ' Another workbook's window is active, but ThisWorkbook is > printing. > ' We don't know for sure which worksheets are printing, so > ' SizeColumns for all of ThisWorkbook's Worksheets. > For Each Sheet In Me.Worksheets > SizeColumns Sheet > Next Sheet > > End If > > 'Cleanup > Set Sheet = Nothing > Set Window = Nothing > End Sub**** > > ** ** > > Asa**** > > ** ** > > ** ** > > *From:* excel-macros@googlegroups.com [ > mailto:excel-macros@googlegroups.com <excel-macros@googlegroups.com>] *On > Behalf Of *David Grugeon > *Sent:* Saturday, June 16, 2012 4:11 AM > *To:* excel-macros@googlegroups.com > *Subject:* Re: $$Excel-Macros$$ Find Narrow Cells & Appying Auto fit to > only that cell**** > > ** ** > > You cannot apply autofit only to one cell. It has to apply to a whole > column. One cell cannot be a different width than the column. The only > way you could achieve that appearance would be to merge cells.**** > > ** ** > > Regards**** > > David Grugeon**** > > On 16 June 2012 18:10, Prashant Pawle <ppawle.ex...@gmail.com> wrote:**** > > Dear Team,**** > > ** ** > > Please help of some macro to find Narrow Cells & Appying Auto fit to only > that cell , sample sheet attached**** > > ** ** > > Regards,**** > > ** ** > > Prashant**** > > -- > -- 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 **** > > > > **** > > ** ** > > -- > David Grugeon**** > > -- > 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**** > > -- > 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
