PDA

View Full Version : Sleeper: Inserting spaces



Johnlemons
08-29-2005, 09:28 AM
I have column D at 28 width and need to resize it to 36.
All of the stuff in col D has been formated for the 28 width.
And example of the data is as follows:

DEPOSIT (text)
Check 101 (Walmart)
Fee (Monthly Bank fee)

I need to put in spaces before the ( so that it will fit to the
36 width. The problem I have is that when the text is bold
you cant get as many spaces as when they are regular.
so when I get the space before the "(" I need to put in 14
or 18 spaces depending wether or not that space is bold?

Or is there an easier way to make everthing line up?

Thanks,:doh:
Johnlemons.

mvidas
08-29-2005, 10:10 AM
Hi John,

Why do you need it to fill in the spaces of the columns?

Assuming you just do, have you tried making your font Courier New, or one of the other fonts which use the same space regardless of the letter/formatting? As an example, here is your sample text, first in the default font of the forum (verdana), then in courier new:

DEPOSIT (text)
Check 101 (Walmart)
Fee (Monthly Bank fee)

DEPOSIT (text)
Check 101 (Walmart)
Fee (Monthly Bank fee)

As you can see, they have the same letters and formatting, but look different. Each character has the same width. If you're trying to make it 36 characters wide, you could just pad the end of it with spaces. But if you're trying to keep it internally, you would only have to search for the "(" character, and add (36 - length) spaces before that character. If this is something you'd be interested in, let us know and we can write you a macro to do this. Keeping the bolded inner-text bolded would make it quite a bit slower, so let us know if you need the inner-text formatting kept as is.

Matt

mvidas
08-29-2005, 10:45 AM
OK John, I've made a function to do this for you. It would have been a lot shorter and easier (and quicker) if you didn't need the inner-cell formatting. But as it is now, pass the range of cells to be updated to the function (from VBA, not as a worksheet function).


Function PadCells(ByVal TheRange As Range) As Boolean
Dim i As Long, NewCellLength As Long, j As Long, iPos As Long, NumSpaces As Long
Dim TempCLL As Range, tempWS As Worksheet, ACell As Range, AppSU As Boolean
NewCellLength = 36
AppSU = Application.ScreenUpdating
Application.ScreenUpdating = False
Set tempWS = Sheets.Add
Set TempCLL = tempWS.Range("A1")
For Each ACell In TheRange.Cells
TempCLL.Clear
iPos = InStr(1, ACell.Text, "(")
If iPos = 0 Then iPos = Len(ACell.Text) + 1
NumSpaces = NewCellLength - Len(ACell.Text)
TempCLL = Left(ACell.Text, iPos - 1) & String(NumSpaces, " ") & Mid(ACell.Text, iPos)
For i = 1 To iPos - 1
With TempCLL.Characters(i, 1).Font
.Name = ACell.Characters(i, 1).Font.Name
.FontStyle = ACell.Characters(i, 1).Font.FontStyle
.Size = ACell.Characters(i, 1).Font.Size
.Strikethrough = ACell.Characters(i, 1).Font.Strikethrough
.Superscript = ACell.Characters(i, 1).Font.Superscript
.Subscript = ACell.Characters(i, 1).Font.Subscript
.OutlineFont = ACell.Characters(i, 1).Font.OutlineFont
.Shadow = ACell.Characters(i, 1).Font.Shadow
.Underline = ACell.Characters(i, 1).Font.Underline
.ColorIndex = ACell.Characters(i, 1).Font.ColorIndex
End With
Next 'i
For i = iPos To Len(ACell.Text)
With TempCLL.Characters(i + NumSpaces, 1).Font
.Name = ACell.Characters(i, 1).Font.Name
.FontStyle = ACell.Characters(i, 1).Font.FontStyle
.Size = ACell.Characters(i, 1).Font.Size
.Strikethrough = ACell.Characters(i, 1).Font.Strikethrough
.Superscript = ACell.Characters(i, 1).Font.Superscript
.Subscript = ACell.Characters(i, 1).Font.Subscript
.OutlineFont = ACell.Characters(i, 1).Font.OutlineFont
.Shadow = ACell.Characters(i, 1).Font.Shadow
.Underline = ACell.Characters(i, 1).Font.Underline
.ColorIndex = ACell.Characters(i, 1).Font.ColorIndex
End With
Next 'i
TempCLL.Copy ACell
Next 'ACell
Application.DisplayAlerts = False
tempWS.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = AppSU
End Function[/vba]To call it, just do something along the lines of [vba]Sub TestSub()
PadCells Range("B1:B600")
End Sub

Matt

Johnlemons
08-29-2005, 11:03 AM
Thanks Matt. I'm attaching a sample of what I was wanting to do.
I'll check your code and see it works. I'll let you know.

mvidas
08-29-2005, 12:11 PM
Hi John,

I looked at your test book, and my macro will not help you as you have it. Even changing the font to a fixed-width font wont work, as some of your cells have more than 36 characters.

Doing what you need would definately be better manually, though I can probably write a slow macro to do this for you (may need a little manual updating). Let me try a few things out, I'll let you know what I come up with.

Matt

mvidas
08-29-2005, 01:01 PM
OK, I do have a different function here, though I want to warn you it isn't 100% the same as you had. I'd say give it a try, see if it meets your needs. The only difference is that by doing it automatically, there is a little padding to the right of the text (just as there would be if you did Format / Columns / Autofit on the 'Should Be' column). The rest of it should be just about perfect. As stated previously, this is not a speedy macro! But it'll still be faster and easier than doing it by hand. Try it on your test book, and if it suits your needs, try it on a small range in your real workbook before doing the whole thing. Let me know if you need any more help with it:


Sub TestSub()
PadCells Range("B4:B18")
End Sub

Function PadCells(ByVal TheRange As Range) As Boolean
Dim i As Long, j As Long, NewColumnWidth As Long, iPos As Long, NumSpaces As Long
Dim TempCLL As Range, tempWS As Worksheet, ACell As Range, AppSU As Boolean
Dim SameWidth As Boolean
NewColumnWidth = 36
AppSU = Application.ScreenUpdating
Application.ScreenUpdating = False
Set tempWS = Sheets.Add
Set TempCLL = tempWS.Range("A1")
TheRange.EntireColumn.ColumnWidth = NewColumnWidth
For Each ACell In TheRange.Cells
TempCLL.Clear
iPos = InStr(1, ACell.Text, "(")
If iPos <> 0 Then
For j = iPos - 1 To 1 Step -1
If Mid(ACell.Text, j, 1) <> " " Then Exit For
Next 'j
NumSpaces = 0
ACell.Copy TempCLL
TempCLL.Columns.AutoFit
Do Until TempCLL.EntireColumn.ColumnWidth >= NewColumnWidth
TempCLL = Left(ACell.Text, j) & String(NumSpaces, " ") & Mid(ACell.Text, iPos)
For i = 1 To j
With TempCLL.Characters(i, 1).Font
.Name = ACell.Characters(i, 1).Font.Name
.FontStyle = ACell.Characters(i, 1).Font.FontStyle
.Size = ACell.Characters(i, 1).Font.Size
.Strikethrough = ACell.Characters(i, 1).Font.Strikethrough
.Superscript = ACell.Characters(i, 1).Font.Superscript
.Subscript = ACell.Characters(i, 1).Font.Subscript
.OutlineFont = ACell.Characters(i, 1).Font.OutlineFont
.Shadow = ACell.Characters(i, 1).Font.Shadow
.Underline = ACell.Characters(i, 1).Font.Underline
.ColorIndex = ACell.Characters(i, 1).Font.ColorIndex
End With
Next 'i
TempCLL.Characters(j + 1, NumSpaces).Font.Size = 3
With TempCLL.Characters(j + NumSpaces + 1).Font
.Name = ACell.Characters(iPos).Font.Name
.FontStyle = ACell.Characters(iPos).Font.FontStyle
.Size = ACell.Characters(iPos).Font.Size
.Strikethrough = ACell.Characters(iPos).Font.Strikethrough
.Superscript = ACell.Characters(iPos).Font.Superscript
.Subscript = ACell.Characters(iPos).Font.Subscript
.OutlineFont = ACell.Characters(iPos).Font.OutlineFont
.Shadow = ACell.Characters(iPos).Font.Shadow
.Underline = ACell.Characters(iPos).Font.Underline
.ColorIndex = ACell.Characters(iPos).Font.ColorIndex
End With
TempCLL.Columns.AutoFit
NumSpaces = NumSpaces + 1
Loop
TempCLL.Copy ACell
End If
Next 'ACell
Application.DisplayAlerts = False
tempWS.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = AppSU
End Function

Also, no matter how hard I tried, I couldn't get the "Unemployment" from row 10 to turn into "Paycheck" like your test book wants. I guess VBA can't get a good job either :)
Matt

geekgirlau
08-29-2005, 04:30 PM
A very simple solution would be to take the string in brackets and move it one column to the right, and format the column so that the horizontal alignment is right. Then everything would line up regardless of font. Is this an option for you?