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
