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] 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 <mailto:excel-macros%2bunsubscr...@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