Pookiemeister
Well-known Member
- Joined
- Jan 6, 2012
- Messages
- 563
- Office Version
- 365
- 2010
- Platform
- Windows
On my spreadsheet I have named cells and some are merged. The cells that are named (merged and not merged) do not trigger the run-time error and the merged cells are on the same row. However, the problem occurs when the code gets to this line:
but the line highlighted in yellow is
which make sense, since the above code isn't a named range. All I am wanting to achieve is when the code reaches this line, loop through each cell starting in "C19" and ending on "C32" and perform this code which autosize merged cells to fit the text:
The full code is below.
I really hope this makes sense. If you have any questions, please let me know. ThankYou.
Code:
Range("C19:C32").Value = ""
Code:
str01 = ActiveCell.Name.Name
Code:
If Not Intersect(Target, Range(str01)) Is Nothing Then
Application.ScreenUpdating = False
On Error Resume Next
Set AutoFitRng = Range(Range(str01).MergeArea.Address)
With AutoFitRng
.MergeCells = False
CWidth = .Cells(1).ColumnWidth
MergeWidth = 0
For Each cM In AutoFitRng
cM.WrapText = True
MergeWidth = cM.ColumnWidth + MergeWidth
Next
'small adjustment to temporary width
MergeWidth = MergeWidth + AutoFitRng.Cells.Count * 0.66
.Cells(1).ColumnWidth = MergeWidth
.EntireRow.AutoFit
NewRowHt = .RowHeight
.Cells(1).ColumnWidth = CWidth
.MergeCells = True
.RowHeight = NewRowHt
End With
Application.ScreenUpdating = True
End If
The full code is below.
VBA Code:
Private Sub UserForm_Initialize()
answ = 0
Worksheets("Purchase Order").Select
Range("VendorName").Select
Range("VendorName").Value = ""
Range("VendorNumber").Select
Range("VendorNumber").Value = ""
Range("QuoteNumber").Select
Range("QuoteNumber").Value = ""
Range("PONumber").Select
Range("PONumber").Value = ""
Range("C19:C32").Select
Range("C19:C32").Value = ""
Range("D19:E32").Select
Range("D19:E32").Value = ""
Range("F19:K32").Select
Range("F19:K32").Value = ""
Range("L19:L32").Select
Range("L19:L32").Value = ""
Me.Caption = "Purchase Order Form " & " Date: " & Format(Now, "mm/dd/yyyy") & " Time: " & Format(Now, "hh:mm")
End Sub
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
Dim cellsAddress As String
Debug.Print Selection.Cells.Address
cellsAddress = Selection.Cells.Address
Debug.Print cellsAddress
str01 = ActiveCell.Name.Name
Select Case str01
Case Is = "VendorName"
If Not Intersect(Target, Range(str01)) Is Nothing Then
Application.ScreenUpdating = False
On Error Resume Next
Set AutoFitRng = Range(Range(str01).MergeArea.Address)
With AutoFitRng
.MergeCells = False
CWidth = .Cells(1).ColumnWidth
MergeWidth = 0
For Each cM In AutoFitRng
cM.WrapText = True
MergeWidth = cM.ColumnWidth + MergeWidth
Next
'small adjustment to temporary width
MergeWidth = MergeWidth + AutoFitRng.Cells.Count * 0.66
.Cells(1).ColumnWidth = MergeWidth
.EntireRow.AutoFit
NewRowHt = .RowHeight
.Cells(1).ColumnWidth = CWidth
.MergeCells = True
.RowHeight = NewRowHt
End With
Application.ScreenUpdating = True
End If
Case Is = "VendorNumber"
If Not Intersect(Target, Range(str01)) Is Nothing Then
Application.ScreenUpdating = False
On Error Resume Next
Set AutoFitRng = Range(Range(str01).MergeArea.Address)
With AutoFitRng
.MergeCells = False
CWidth = .Cells(1).ColumnWidth
MergeWidth = 0
For Each cM In AutoFitRng
cM.WrapText = True
MergeWidth = cM.ColumnWidth + MergeWidth
Next
'small adjustment to temporary width
MergeWidth = MergeWidth + AutoFitRng.Cells.Count * 0.66
.Cells(1).ColumnWidth = MergeWidth
.EntireRow.AutoFit
NewRowHt = .RowHeight
.Cells(1).ColumnWidth = CWidth
.MergeCells = True
.RowHeight = NewRowHt
End With
Application.ScreenUpdating = True
End If
Case Is = "QuoteNumber"
If Not Intersect(Target, Range(str01)) Is Nothing Then
Application.ScreenUpdating = False
On Error Resume Next
Set AutoFitRng = Range(Range(str01).MergeArea.Address)
With AutoFitRng
.MergeCells = False
CWidth = .Cells(1).ColumnWidth
MergeWidth = 0
For Each cM In AutoFitRng
cM.WrapText = True
MergeWidth = cM.ColumnWidth + MergeWidth
Next
'small adjustment to temporary width
MergeWidth = MergeWidth + AutoFitRng.Cells.Count * 0.66
.Cells(1).ColumnWidth = MergeWidth
.EntireRow.AutoFit
NewRowHt = .RowHeight
.Cells(1).ColumnWidth = CWidth
.MergeCells = True
.RowHeight = NewRowHt
End With
Application.ScreenUpdating = True
End If
Case Is = "PONumber"
If Not Intersect(Target, Range(str01)) Is Nothing Then
Application.ScreenUpdating = False
On Error Resume Next
Set AutoFitRng = Range(Range(str01).MergeArea.Address)
With AutoFitRng
.MergeCells = False
CWidth = .Cells(1).ColumnWidth
MergeWidth = 0
For Each cM In AutoFitRng
cM.WrapText = True
MergeWidth = cM.ColumnWidth + MergeWidth
Next
'small adjustment to temporary width
MergeWidth = MergeWidth + AutoFitRng.Cells.Count * 0.66
.Cells(1).ColumnWidth = MergeWidth
.EntireRow.AutoFit
NewRowHt = .RowHeight
.Cells(1).ColumnWidth = CWidth
.MergeCells = True
.RowHeight = NewRowHt
End With
Application.ScreenUpdating = True
End If
Dim str02 As String
str02 = Cells(19, 3).Select
str02 = ActiveCell.Address
Select Case str02
Case Is = Range("$C$19:$C$32").Address
For i = 19 To 32
Cells(i, 3).Select
str02 = ActiveCell.Address
Next i
Case Is = Range("$D$19:$E$32").Address
For i = 19 To 32
Cells(i, 4).Select
str02 = ActiveCell.Address
Next i
Case Is = Range("$F$19:$K$32").Address
For i = 19 To 32
Cells(i, 6).Select
str02 = ActiveCell.Address
Next i
Case Is = Range("$L$19:$L$32").Address
For i = 19 To 32
Cells(i, 12).Select
str02 = ActiveCell.Address
Next i
End Select
End Select
End Sub
I really hope this makes sense. If you have any questions, please let me know. ThankYou.