emailvikash
New Member
- Joined
- Oct 29, 2009
- Messages
- 1
A) I have this mini dashboard where I have to merge a few cells and wrap them. So I used one of the macro from this site to autohightadjust the merged and wrapped cells.
B) Then I had to record another macro to run the above macro on a group of cells
Then I created another macro to run B) macro (which internally runs A) macro) when I open the excel file.
Next I had to protect the sheet so that only a few cells need to be editable. However here is where the error began. To ensure that error does not appear I protected the sheet manually (without macros) but still I get an debug error. When I try protecting it with a macro the error still appears.
HELPPPPPP!!!!!!!!!!
Macro A)
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
End Sub
Macro1:
Sub Macro1()
'
' Macro1 Macro
' Macro recorded 10/29/2009 by Vikash
'
' Keyboard Shortcut: Ctrl+a
'
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("D37:I37").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("D38:I38").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("D39:I39").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("D40:I40").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("D41:I41").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("D42:I42").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("D43:I43").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("D44:I44").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("D45:I45").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("D46:I46").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
ActiveWindow.SmallScroll Down:=12
Range("D47:I47").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("D48:I48").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("D49:I49").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("D50:I50").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("B50:C50").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("B49:C49").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("B48:C48").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("B47:C47").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("B46:C46").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("B45:C45").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("B44:C44").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("B43:C43").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("B42:C42").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("B41:C41").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
ActiveWindow.SmallScroll Down:=-9
Range("B40:C40").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("B39:C39").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("B38:C38").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("B37:C37").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("B36:C36").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
ActiveWindow.SmallScroll Down:=-45
End Sub
Macro2
Sub Macro2()
'
' Macro2 Macro
' Macro recorded 10/29/2009 by a142982
'
'
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
Macro3:
Private Sub Workbook_Open()
Macro1
Macro2
End Sub
B) Then I had to record another macro to run the above macro on a group of cells
Then I created another macro to run B) macro (which internally runs A) macro) when I open the excel file.
Next I had to protect the sheet so that only a few cells need to be editable. However here is where the error began. To ensure that error does not appear I protected the sheet manually (without macros) but still I get an debug error. When I try protecting it with a macro the error still appears.
HELPPPPPP!!!!!!!!!!
Macro A)
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
End Sub
Macro1:
Sub Macro1()
'
' Macro1 Macro
' Macro recorded 10/29/2009 by Vikash
'
' Keyboard Shortcut: Ctrl+a
'
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("D37:I37").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("D38:I38").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("D39:I39").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("D40:I40").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("D41:I41").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("D42:I42").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("D43:I43").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("D44:I44").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("D45:I45").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("D46:I46").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
ActiveWindow.SmallScroll Down:=12
Range("D47:I47").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("D48:I48").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("D49:I49").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("D50:I50").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("B50:C50").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("B49:C49").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("B48:C48").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("B47:C47").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("B46:C46").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("B45:C45").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("B44:C44").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("B43:C43").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("B42:C42").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("B41:C41").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
ActiveWindow.SmallScroll Down:=-9
Range("B40:C40").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("B39:C39").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("B38:C38").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("B37:C37").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
Range("B36:C36").Select
Application.Run "Template.xls!AutoFitMergedCellRowHeight"
ActiveWindow.SmallScroll Down:=-45
End Sub
Macro2
Sub Macro2()
'
' Macro2 Macro
' Macro recorded 10/29/2009 by a142982
'
'
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
Macro3:
Private Sub Workbook_Open()
Macro1
Macro2
End Sub