none
VB: UDF? for LEFT & RIGHT Justify Text in a cell.. for variable space in middle RRS feed

  • Question

  • hi,  i do not know if this is even possible, but i am trying to neaten up the view of text i have in a cell.  (i have see where what looks difficult for me, might actually have an easy for you guys.. solution). this is more of a necessity to do work and is causing some problems.  thanks in advance.

    examples are:

    =A9&"  "&B9    where would need any number of spaces to get B9 to justify to the right of the cell.  some samples of the data might be:

    S1  P99    (move P99 to right justified, with a larger space in the middle, and minimum of 1 space)

    SGA  G24

    D0  V00

    PSB  P00

    PSC  P11

    S2  Q10

     

     

    i am not that quick at vb, but do spend alot of hours trying to make things work..  the outline example could be like:

     

    FUNCTION goS()    'gospace    call as:  =A9&goS&B9

    for VALUE character count = cell width then goS = variable space width

    i have done something before for bottom row minus top row / 100 = xtimes,  so?:  column width minus character space width = goS (middle space width),  with a minimum of 1 space between both sides.

     

    i do not think i can just try to measure the character width of cells columns A & B.  actual calculations are performed within the cell.  an example dealing with is more like the following,  but getting rid of the center line: 

     

    =AI9&CHOOSE(MATCH(AF9,TF,0),"","F","G","S","0","  ")&IF(AND(Q9>3,AF9<3,AJ9>0),CHAR(AJ9+64),AJ9)&
    IF((AF9>3)*(AI9<>"g"),IF(AF9>4,"   "," "),"")&IF(AND(AF9<4,AJ9>1,CIF(AH9:AI9,{"m";"q"}))," ","  ")&
    IF(N9>4,"B",IF(DC9="b","L",IF(AI9<>AH9,AH9,IF(CIF(DC9,LIST4),DC9,AI9))))&V9&W9

      
    could maybe change to:
      
      
    =AI9&CHOOSE(MATCH(AF9,TF,0),"","F","G","S","0","  ")&IF(AND(Q9>3,AF9<3,AJ9>0),CHAR(AJ9+64),AJ9)&
    goS&IF(N9>4,"B",IF(DC9="b","L",IF(AI9<>AH9,AH9,IF(CIF(DC9,LIST4),DC9,AI9))))&V9&W9






    • Edited by Davexx Wednesday, October 11, 2017 9:04 PM
    Wednesday, October 11, 2017 7:55 PM

Answers

  • Rather than use a UDF I have used Worksheet Change event so the justification is inserted immediately after the value is entered.

    Note that because of the method that Excel uses to increment column width based on average width of characters rather than same for every character, not possible to produce 100% accurate result but under test it is quite close. (I have not tested but I understand that Courier font uses same width for all characters so might work better with Courier but I will leave you to test.)

    The code does the following:

    1. Test that only one cell changed. (Does not process if multiple cells change simultaneously).
    2. Test that at least one space in the source data. (Otherwise can't determine where to pad out with additional spaces)
    3. Copy the source column format plus column width to a temporary column out to right of worksheet data. (Edit code where indicated with comment for your temporary column.)
    4. Remove all but one space from the source string.
    5. Copy the source string to first cell of temporary column.
    6. In a Do/Loop increments the spaces until the AutoFit Column width of the Temporary column is wider than the source column. (Indicates one space too many)
    7. Remove one space from Temporary string.
    8. Copy temporary string back to source.

    Right click the worksheet tab and select "View Code" to open the VBA editor at the correct module for the Event code for the worksheet.

    Test if it does what you want and feel free to get back to me with any questions etc.

    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim i As Long
        Dim rngSourceCol As Range
        Dim rngTempCol As Range
       
        If Target.Cells.Count = 1 Then      'Do NOT process for multiple cell changes
            If InStr(1, Target.Value, " ") > 0 Then   'Do NOT process if no spaces in initial string
               
                Set rngSourceCol = Columns("A:A")      'Edit "A:A" to your source data column
                Set rngTempCol = Columns("Z:Z")         'Edit "Z:Z" to spare column to right of all other data
           
                On Error GoTo ReEnableEvents
                Application.EnableEvents = False
               
                rngTempCol.ClearContents
                rngSourceCol.Copy
                rngTempCol.PasteSpecial xlFormats
                Application.CutCopyMode = False
                rngTempCol.ColumnWidth = rngSourceCol.ColumnWidth
               
                'Remove all but one space from the source string
                Do
                    Target.Value = Replace(Target.Value, "  ", " ", , 1)
                    If InStr(1, Target.Value, "  ") = 0 Then
                        Exit Do
                    End If
                Loop
               
                'Copy source string to temporary location
                Target.Copy Destination:=Cells(1, "Z")
               
                Do
                    Cells(1, "Z").Value = Replace(Cells(1, "Z").Value, " ", "  ", , 1) 'Increment spaces
                    rngTempCol.AutoFit
                    If rngTempCol.ColumnWidth > rngSourceCol.ColumnWidth Then
                        Cells(1, "Z").Value = Replace(Cells(1, "Z").Value, " ", "", , 1) 'Decrement by one space
                        Exit Do
                    End If
                Loop
               
                Target.Value = Cells(1, "Z").Value  'Copy temporary string back to source
                Target.Select
               
                rngTempCol.ClearContents
               
            Else
                MsgBox "No spaces in the initial string"
            End If
           
        End If
           
    ReEnableEvents:
            If Err.Number <> 0 Then
                MsgBox "Error occurred in Module Sheet1, Private Sub Worksheet_Change" 'Edit module name
            End If
            Application.EnableEvents = True
       
       
    End Sub


    Regards, OssieMac

    Thursday, October 12, 2017 4:18 AM

All replies

  • Rather than use a UDF I have used Worksheet Change event so the justification is inserted immediately after the value is entered.

    Note that because of the method that Excel uses to increment column width based on average width of characters rather than same for every character, not possible to produce 100% accurate result but under test it is quite close. (I have not tested but I understand that Courier font uses same width for all characters so might work better with Courier but I will leave you to test.)

    The code does the following:

    1. Test that only one cell changed. (Does not process if multiple cells change simultaneously).
    2. Test that at least one space in the source data. (Otherwise can't determine where to pad out with additional spaces)
    3. Copy the source column format plus column width to a temporary column out to right of worksheet data. (Edit code where indicated with comment for your temporary column.)
    4. Remove all but one space from the source string.
    5. Copy the source string to first cell of temporary column.
    6. In a Do/Loop increments the spaces until the AutoFit Column width of the Temporary column is wider than the source column. (Indicates one space too many)
    7. Remove one space from Temporary string.
    8. Copy temporary string back to source.

    Right click the worksheet tab and select "View Code" to open the VBA editor at the correct module for the Event code for the worksheet.

    Test if it does what you want and feel free to get back to me with any questions etc.

    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim i As Long
        Dim rngSourceCol As Range
        Dim rngTempCol As Range
       
        If Target.Cells.Count = 1 Then      'Do NOT process for multiple cell changes
            If InStr(1, Target.Value, " ") > 0 Then   'Do NOT process if no spaces in initial string
               
                Set rngSourceCol = Columns("A:A")      'Edit "A:A" to your source data column
                Set rngTempCol = Columns("Z:Z")         'Edit "Z:Z" to spare column to right of all other data
           
                On Error GoTo ReEnableEvents
                Application.EnableEvents = False
               
                rngTempCol.ClearContents
                rngSourceCol.Copy
                rngTempCol.PasteSpecial xlFormats
                Application.CutCopyMode = False
                rngTempCol.ColumnWidth = rngSourceCol.ColumnWidth
               
                'Remove all but one space from the source string
                Do
                    Target.Value = Replace(Target.Value, "  ", " ", , 1)
                    If InStr(1, Target.Value, "  ") = 0 Then
                        Exit Do
                    End If
                Loop
               
                'Copy source string to temporary location
                Target.Copy Destination:=Cells(1, "Z")
               
                Do
                    Cells(1, "Z").Value = Replace(Cells(1, "Z").Value, " ", "  ", , 1) 'Increment spaces
                    rngTempCol.AutoFit
                    If rngTempCol.ColumnWidth > rngSourceCol.ColumnWidth Then
                        Cells(1, "Z").Value = Replace(Cells(1, "Z").Value, " ", "", , 1) 'Decrement by one space
                        Exit Do
                    End If
                Loop
               
                Target.Value = Cells(1, "Z").Value  'Copy temporary string back to source
                Target.Select
               
                rngTempCol.ClearContents
               
            Else
                MsgBox "No spaces in the initial string"
            End If
           
        End If
           
    ReEnableEvents:
            If Err.Number <> 0 Then
                MsgBox "Error occurred in Module Sheet1, Private Sub Worksheet_Change" 'Edit module name
            End If
            Application.EnableEvents = True
       
       
    End Sub


    Regards, OssieMac

    Thursday, October 12, 2017 4:18 AM
  • hi,  thanks for the reply.  sorry so long to get back.  if not having my own things slowing me down and problems with pc and do a reinstall,  but have to fix some things first.

    with my version of an operating system & excel i am stuck for now, on being at my last column. 

    your example is greatly needed & will be used.  with the amount of work doing, rewriting everything...  months to go maybe but i am had to use 2nd last column to make this problem work right away.  it proves neater to have a precise "Justify Right" and have used that method for now. 

    the view of my work has otherwise become untenable with the example of having what might be considered:  having 2 fields of data in the same column..  to simulate 1 column, with 2 columns.

    i would put your work on a wish list to have ms make it part of the excel app.  adjustments to include precise lineup of 'columns' of data in the same column.  even if more than 2 sets of data:  to have the left side in a straight line..  (or maybe say:  right side, justified left).  would rather have a VB variable to add to a formula like in first post:  =IF(abc,xyz,mne)&goSPACE&IF(gef,mne,stx)

    thanks for the help.  as soon as i can upgrade - get more columns i will be able to put that to use.

    Tuesday, November 28, 2017 1:10 PM