Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro in 1 cell vs entire spreadsheet
Hi guys,
I have a macro (see Below) that works when you run it, BUT ONLY runs on the currently selected cell. I need it to run over the entire spreadsheet (or preferably over a range that I specify, say A5:s100 - there are several sheets and ranges though...) Please can someone help.... Kind Regards Darin Sub AutoFitMergedCellRowHeight() Dim CurrentRowHeight As Single, MergedCellRgWidth As Single Dim CurrCell As Range Dim ActiveCellWidth As Single, PossNewRowHeight As Single If ActiveCell.MergeCells Then With ActiveCell.MergeArea If .Rows.Count = 1 And .WrapText = True Then Application.ScreenUpdating = False CurrentRowHeight = .RowHeight ActiveCellWidth = ActiveCell.ColumnWidth For Each CurrCell In Selection MergedCellRgWidth = CurrCell.ColumnWidth + _ MergedCellRgWidth Next .MergeCells = False .Cells(1).ColumnWidth = MergedCellRgWidth .EntireRow.AutoFit PossNewRowHeight = .RowHeight .Cells(1).ColumnWidth = ActiveCellWidth .MergeCells = True .RowHeight = IIf(CurrentRowHeight PossNewRowHeight, _ CurrentRowHeight, PossNewRowHeight) End If End With End If *** Sent via Developersdex http://www.developersdex.com *** Don't just participate in USENET...get rewarded for it! |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro in 1 cell vs entire spreadsheet
You can try this untested modification and see if it helps.
Sub AutoFitMergedCellRowHeight() Dim cell as Range, rng as Range Dim CurrentRowHeight As Single, MergedCellRgWidth As Single Dim CurrCell As Range Dim ActiveCellWidth As Single, PossNewRowHeight As Single for each cell in Selection if rng is nothing then set rng = cell.MergeArea else if Intersect(rng,cell.MergeArea) is nothing then if cell.MergeCells then set rng = union(rng,cell.MergeArea) end if end if end if if rng is nothing then exit sub for each cell in rng.Areas cell.select If ActiveCell.MergeCells Then With ActiveCell.MergeArea If .Rows.Count = 1 And .WrapText = True Then Application.ScreenUpdating = False CurrentRowHeight = .RowHeight ActiveCellWidth = ActiveCell.ColumnWidth For Each CurrCell In Selection MergedCellRgWidth = CurrCell.ColumnWidth + _ MergedCellRgWidth Next .MergeCells = False .Cells(1).ColumnWidth = MergedCellRgWidth .EntireRow.AutoFit PossNewRowHeight = .RowHeight .Cells(1).ColumnWidth = ActiveCellWidth .MergeCells = True .RowHeight = IIf(CurrentRowHeight PossNewRowHeight, _ CurrentRowHeight, PossNewRowHeight) End If End With End If Next End Sub -- Regards, Tom Ogilvy "Darin Kramer" wrote in message ... Hi guys, I have a macro (see Below) that works when you run it, BUT ONLY runs on the currently selected cell. I need it to run over the entire spreadsheet (or preferably over a range that I specify, say A5:s100 - there are several sheets and ranges though...) Please can someone help.... Kind Regards Darin Sub AutoFitMergedCellRowHeight() Dim CurrentRowHeight As Single, MergedCellRgWidth As Single Dim CurrCell As Range Dim ActiveCellWidth As Single, PossNewRowHeight As Single If ActiveCell.MergeCells Then With ActiveCell.MergeArea If .Rows.Count = 1 And .WrapText = True Then Application.ScreenUpdating = False CurrentRowHeight = .RowHeight ActiveCellWidth = ActiveCell.ColumnWidth For Each CurrCell In Selection MergedCellRgWidth = CurrCell.ColumnWidth + _ MergedCellRgWidth Next .MergeCells = False .Cells(1).ColumnWidth = MergedCellRgWidth .EntireRow.AutoFit PossNewRowHeight = .RowHeight .Cells(1).ColumnWidth = ActiveCellWidth .MergeCells = True .RowHeight = IIf(CurrentRowHeight PossNewRowHeight, _ CurrentRowHeight, PossNewRowHeight) End If End With End If *** Sent via Developersdex http://www.developersdex.com *** Don't just participate in USENET...get rewarded for it! |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro in 1 cell vs entire spreadsheet
Thanks Tom,
I get a "For control variable already in use" error and it highlights the following VBA For Each cell In rng.Areas (16 lines down) This is the final Macro in the book I been preparing, so really desparate for it to work. Thanks so much for the effort. *** Sent via Developersdex http://www.developersdex.com *** Don't just participate in USENET...get rewarded for it! |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro in 1 cell vs entire spreadsheet
left out the End for
for the NEXT Sub AutoFitMergedCellRowHeight() Dim cell As Range, rng As Range Dim CurrentRowHeight As Single, MergedCellRgWidth As Single Dim CurrCell As Range Dim ActiveCellWidth As Single, PossNewRowHeight As Single For Each cell In Selection If rng Is Nothing Then Set rng = cell.MergeArea Else If Intersect(rng, cell.MergeArea) Is Nothing Then If cell.MergeCells Then Set rng = Union(rng, cell.MergeArea) End If End If End If Next If rng Is Nothing Then Exit Sub For Each cell In rng.Areas cell.Select If ActiveCell.MergeCells Then With ActiveCell.MergeArea If .Rows.Count = 1 And .WrapText = True Then Application.ScreenUpdating = False CurrentRowHeight = .RowHeight ActiveCellWidth = ActiveCell.ColumnWidth For Each CurrCell In Selection MergedCellRgWidth = CurrCell.ColumnWidth + _ MergedCellRgWidth Next .MergeCells = False .Cells(1).ColumnWidth = MergedCellRgWidth .EntireRow.AutoFit PossNewRowHeight = .RowHeight .Cells(1).ColumnWidth = ActiveCellWidth .MergeCells = True .RowHeight = IIf(CurrentRowHeight PossNewRowHeight, _ CurrentRowHeight, PossNewRowHeight) End If End With End If Next End Sub "Darin Kramer" wrote in message ... Thanks Tom, I get a "For control variable already in use" error and it highlights the following VBA For Each cell In rng.Areas (16 lines down) This is the final Macro in the book I been preparing, so really desparate for it to work. Thanks so much for the effort. *** Sent via Developersdex http://www.developersdex.com *** Don't just participate in USENET...get rewarded for it! |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro in 1 cell vs entire spreadsheet
Thanks Tom,
I sorta guessed to put that next in. I dont get an error message, but the formulae seems to work erraticly... ie does not work on a block of text, but will work on certain types of info, eg blank line above merged text, resolves spacing with merged text fine. Two blank lines, or more than one line of merged text... no go.. Really appreciate your assistance - this is the big one!! - calling it a night, but will check first thing tomorrow. Thanks a million! *** Sent via Developersdex http://www.developersdex.com *** Don't just participate in USENET...get rewarded for it! |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro in 1 cell vs entire spreadsheet
does the original code work on those cells which you say are problematic?
(the orginal code run on each of the merged areas individually) -- Regards, Tom Ogilvy "Darin Kramer" wrote in message ... Thanks Tom, I sorta guessed to put that next in. I dont get an error message, but the formulae seems to work erraticly... ie does not work on a block of text, but will work on certain types of info, eg blank line above merged text, resolves spacing with merged text fine. Two blank lines, or more than one line of merged text... no go.. Really appreciate your assistance - this is the big one!! - calling it a night, but will check first thing tomorrow. Thanks a million! *** Sent via Developersdex http://www.developersdex.com *** Don't just participate in USENET...get rewarded for it! |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro in 1 cell vs entire spreadsheet
Morning Tom,
TO answer your question, yes the original code does work on each of the cells individually. When selecting multiple occurences, your code works on the first occurence, but not on the remaining. (takes the cursor to the last occurence, but does not resize. If i select all occurences, and run the original code, it does not work at all. Thanks so much, hoping we can resolve... Big Thanks D *** Sent via Developersdex http://www.developersdex.com *** Don't just participate in USENET...get rewarded for it! |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro in 1 cell vs entire spreadsheet
MergeCells, Merge, Autofit, Rech
Try this: Sub AutoFitMergedCellRowHeight() ' modification of code originally posted by Jim Rech Dim cell As Range, rng As Range Dim CurrentRowHeight As Single, MergedCellRgWidth As Single Dim CurrCell As Range Dim ActiveCellWidth As Single, PossNewRowHeight As Single For Each cell In Selection If cell.MergeCells Then If rng Is Nothing Then Set rng = cell.MergeArea(1) Else If Intersect(rng, cell.MergeArea(1)) Is Nothing Then If cell.MergeCells Then Set rng = Union(rng, cell.MergeArea(1)) End If End If End If End If Next If rng Is Nothing Then Exit Sub For Each cell In rng cell.Select If cell.MergeCells Then With cell.MergeArea If .Rows.Count = 1 And .WrapText = True Then Application.ScreenUpdating = False CurrentRowHeight = .RowHeight MergedCellRgWidth = 0 ActiveCellWidth = cell.ColumnWidth For Each CurrCell In cell.MergeArea MergedCellRgWidth = CurrCell.ColumnWidth + _ MergedCellRgWidth Next .MergeCells = False .Cells(1).ColumnWidth = MergedCellRgWidth .EntireRow.AutoFit PossNewRowHeight = .RowHeight .Cells(1).ColumnWidth = ActiveCellWidth .MergeCells = True .RowHeight = IIf(CurrentRowHeight PossNewRowHeight, _ CurrentRowHeight, PossNewRowHeight) End If End With End If Next End Sub -- Regards, Tom Ogilvy "Darin Kramer" wrote in message ... Morning Tom, TO answer your question, yes the original code does work on each of the cells individually. When selecting multiple occurences, your code works on the first occurence, but not on the remaining. (takes the cursor to the last occurence, but does not resize. If i select all occurences, and run the original code, it does not work at all. Thanks so much, hoping we can resolve... Big Thanks D *** Sent via Developersdex http://www.developersdex.com *** Don't just participate in USENET...get rewarded for it! |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Multiply an entire spreadsheet by 1000 without going into ea cell | Excel Worksheet Functions | |||
Macro to highlight an entire row if a certain value is in a cell | Excel Discussion (Misc queries) | |||
Edit macro to match entire cell contents | Excel Discussion (Misc queries) | |||
How to change numbers in entire spreadsheet from one cell? | Excel Worksheet Functions | |||
Macro for selecting entire row from mouse cell selection | Excel Programming |