Border based around string length

[Oldrat]

Hi

I have a border around a merged and centered cell group.
The group takes a maximum of 18 characters but could contain as few as 3.
When printed using say 3 chars, the border looks a little odd as it covers the entire area for the full set of 18 chars.
Is there a way to expand or contract the borders according to the number of letters.
I don't have any starter code to show as my idea of inserting brackets at the start and end of the string looked poor and ate into my max character allocation!

Any ideas would be welcome

Many thanks

Lee

 

[AFPathfinder]

I'm having a hard time understanding what your border is. Do you mean to shrink the column width to make the cell seem shorter for smaller string lengths? Or, do you have colored cells around the merged cell acting as a border? If you're talking about the actual border, there isn't too many different thicknesses you could change from.

 

[Oldrat]

Hi
I'll try an explain my self a little clearer
The area merged is cells B15 to N19 using the value of B15 merged and centred
The border is around the cells B15 to N19 .
The border is the thick box border option taken from the drop down options (xl2003)
Can't change the column width as this will have a big knock on effect on the sheet layout.
I just wondered if the was a way for vba take care of the bordered area based on string length.
Think I've painted myself into a bit of a corner, but I will look at the idea of coloured cells forming a border and changing them to suit.
Thanks

 

[AFPathfinder]

I don't think it would be too hard, you would just need an If/Select Case statement to compare the length of string in cell B15:

If Len(Range("B15").Value) < 6 Then
    Range("B15").Borders.Weight = xlThin
ElseIf Len(Range("B15").Value) < 12 Then
    Range("B15").Borders.Weight = xlMedium
Else
    Range("B15").Borders.Weight = xlThick
End If(

 

[Oldrat]

Hi
Thanks for your reply, and sorry for being late in in getting back to you.
Your idea got me thinking! and I've come up with this, still very much a work in progress, but I think there is some mileage to be had.
Many thanks

Dim Mrange As String
Sub xx()


With Range("B15:N19") '
.Borders.LineStyle = xlNone
.UnMerge
End With
Select Case Len(Range("B15").Value)


Case Is <= 4
Range("G15").Value = Range("B15").Value
Mrange = "G15:I19"
  Call Borderdraw


Case Is = 5, Is < 7
Range("F15").Value = Range("B15").Value
Mrange = "F15:J19"
Call Borderdraw


Case Is = 7, Is = 10
Range("E15").Value = Range("B15").Value
Mrange = "E15:K19"
Call Borderdraw


Case Is = 11, Is < 14
Mrange = "D15:L19"
Range("D15").Value = Range("B15").Value
'Mrange = "D15:L19"
Call Borderdraw


Case Is >= 14
'Range("B15").Value = Range("B15").Value
Mrange = "B15:N19"
Call Borderdraw
End Select


End Sub


Sub Borderdraw()
With Range(Mrange)
  .Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Borders(xlEdgeLeft).Weight = xlMedium
    .Borders(xlEdgeRight).LineStyle = xlContinuous
    .Borders(xlEdgeRight).Weight = xlMedium
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).Weight = xlMedium
    .Borders(xlEdgeTop).LineStyle = xlContinuous
    .Borders(xlEdgeTop).Weight = xlMedium
     .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
            .ReadingOrder = xlContext
        .MergeCells = True
        End With
End Sub

 

[AFPathfinder]

Not that it would make too much difference, but you can condense the borders syntax.

Sub Borderdraw()
    With Range(Mrange)
        .BorderAround.LineStyle = xlContinuous
        .BorderAround.Weight = xlMedium
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
End Sub