automatically adjustable cells

[Guest]

Hi! I'm trying to setup a worksheet for people to update information.

I was wonder if there's a way to setup the cells so that it will
automatically adjust to the center of the cell depending on the number of
cells that have text in the next column.

ex)
if there's 1 row:
123 ABC

if there's 2 rows:
123
234 ABC <-- would be centered between the 2 rows

if there's 3 rows:
123
234 ABC
345

and so on...I know I can do it manually, but I don't want the people messing
around with the format since they will most likely mess it up. I want to set
it up so that all they need to do is enter the text.

and have a bracket pointing to the 2nd column adjusting its size depending
on how many cells have text in.


If anyone could please help me, I would really appreciate it! And thanks in
advance!

 

[Dave Peterson]

I used A1 to the bottom of column A to center on.

Maybe you can adjust this for your situation.

It figures out the top and bottom cell of that range and merges the cells to its
right--then centers the text in that merged area.

Rightclick on the worksheet tab that should have this behavior. Select view
code and paste this into the code window:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Dim myRng As Range

If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Me.Range("a:a")) Is Nothing Then
Exit Sub
End If

With Me
Set myRng = .Range("a1", .Cells(.Rows.Count, "A").End(xlUp))
End With

With myRng.Offset(0, 1)
.Cells(1).UnMerge
.Merge
.VerticalAlignment = xlCenter
End With

End Sub

 

[Guest]

Thanks Dave.

The code does work, but how do I set it up so that it only affects a
specific worksheet?


Also, I want to have this work for a number of different ranges on the
sheet, how do I set it up so that it could do that?

ex) c6:c7 merges d6:d7 and e6:e7
c9:c10 merges d9:d10

 

[Dave Peterson]

Rightclick on the worksheet tab that should have this behavior. Select view
code and paste this into the code window:

Option Explicit
'c6:c7 merges d6:d7 and e6:e7
' c9:c10 merges d9:d10
Private Sub Worksheet_Change(ByVal Target As Range)

Dim myRng As Range
Dim Rng1 As Range
Dim Rng2 As Range

If Target.Cells.Count > 1 Then Exit Sub

Set Rng1 = Me.Range("c6:c7")
Set Rng2 = Me.Range("c9:c10")

If Not (Intersect(Target, Rng1) Is Nothing) Then
Rng1.Offset(0, 1).Cells(1).UnMerge
Rng1.Offset(0, 2).Cells(1).UnMerge

If Application.CountA(Rng1.Cells) > 0 Then
With Rng1.Offset(0, 1).Resize(Application.CountA(Rng1.Cells))
.Merge
.VerticalAlignment = xlCenter
End With
With Rng1.Offset(0, 2).Resize(Application.CountA(Rng1.Cells))
.Cells(1).UnMerge
.Merge
.VerticalAlignment = xlCenter
End With
End If
End If

If Not (Intersect(Target, Rng2) Is Nothing) Then
Rng2.Offset(0, 1).Cells(1).UnMerge

If Application.CountA(Rng2.Cells) > 0 Then
With Rng2.Offset(0, 1).Resize(Application.CountA(Rng2.Cells))
.Merge
.VerticalAlignment = xlCenter
End With
End If
End If
End Sub

 

[Guest]

Dave, thank you so much!

: