VBA to check cell length and set Horizontal Text Alignment

[philwojo]

Hello, I have a worksheet that I am having users paste data in to. When they do certain cells can have data that is very wide. I don't want to use Wrap Text because the amount of data is large and I need to retain the cell width and height as I have them set.

I would like to use VBA to check a cell length, when the data is pasted in by the user, and if it exceeds a certain length then the formatting for that cell, specifically Text Alignment for Horizontal is set to 'Justify'.

On top of that I have a macro that the users press a button to clear all contents on the page before pasting. I'd also like VBA code to set all cells at that time back to the default Text Alignment for Horizontal back to 'Center' so if the contents don't exceed the lengthy they aren't justified any longer. Basically I want to remove any previously set text alignments from above back to default so that everything is centered unless it exceeds a certain length.

Thanks for any help in advance.
Phil

 

[Eric W]

Re: How to use VBA to check cell length and set Horizontal Text Alingment

You could set up a Worksheet_Change event. Any time something is entered or pasted into a cell (or range of cells), it's called and would adjust the alignment as needed. To try it:

1) Open a copy of your workbook
2) Right click the sheet tab on the bottom and select View Code
3) Paste the following code into the window that opens:

Sub Worksheet_Change(ByVal target As Range)
Dim c As Range

    For Each c In target
        If Not Intersect(c, Range("A1, C:C, D4:D10")) Is Nothing Then
            c.HorizontalAlignment = IIf(Len(c.Value) > 10, xlJustify, xlCenter)
        End If
    Next c
            
End Sub

4) Change the Range statement in the first red line to reflect the cells where you want this to take place. If you want this to work in all cells, just remove both red lines. The 10 in blue determines the number of characters that triggers the Justify.
5) Press Alt-Q to exit the VBA editor.

6) Try it out.

Let us know if this works.

 

[philwojo]

Re: How to use VBA to check cell length and set Horizontal Text Alingment

OK, it doesn't appear to be working, just had a chance to try it this morning.

Can you explain to me the ranging in the IF statement, I am trying to change that, but I am not sure I follow what that is doing to be honest. I am normally able to follow along with code but this one I am just not getting, maybe it is because it is Monday!!

Also, I have a "Clear cells" function on that same sheet, and when I do that it takes a long time for it to complete, is that because this code is being run for each cell that is being cleared in the range?

Thanks for the assistance so far.

Phil

 

[philwojo]

Re: How to use VBA to check cell length and set Horizontal Text Alingment

And just to clarify the range I am working with is from B7:BF6000

 

[Eric W]

Re: How to use VBA to check cell length and set Horizontal Text Alingment

The Range line just tells the macro what cells to work with. Range("A1") means only one cell will have the alignment changed. Range("C:C") means the entire C column would have the alignment changed if someone pasted into that range. You can select multiple non-adjacent ranges with Range("A1, C:C") and so on. It sounds like you want to use Range("B7:BF6000"). If you paste to a big range, it checks each cell in the range to see if the alignment should be changed.

And yes, if you have another macro that clears cells, this macro would be called for the whole range you clear. You might want to put

Application.EnableEvents = False

 ... your clear code ...

Application.EnableEvents = True

This will prevent the WorksheetChange event from firing.

 

[philwojo]

Re: How to use VBA to check cell length and set Horizontal Text Alingment

Thank you for the help Eric, that explanation helped me and now the code is working. I also appreciate the extra code for when I do the "Clear" event.

Phil

 

[Rick Rothstein]

Re: How to use VBA to check cell length and set Horizontal Text Alingment

Sub Worksheet_Change(ByVal target As Range)
Dim c As Range

    For Each c In target
        If Not Intersect(c, Range("A1, C:C, D4:D10")) Is Nothing Then
            c.HorizontalAlignment = IIf(Len(c.Value) > 10, xlJustify, xlCenter)
        End If
    Next c
            
End Sub

I think it might be better to write the above code this way just in case the user copy/pastes a huge amount of data (such as several full columns or rows)...

Sub Worksheet_Change(ByVal Target As Range)
  Dim c As Range

  For Each c In Intersect(Target, Range("A1, C:C, D4:D10"))
    c.HorizontalAlignment = IIf(Len(c.Value) > 10, xlJustify, xlCenter)
  Next c
            
End Sub

 

[philwojo]

Re: How to use VBA to check cell length and set Horizontal Text Alingment

I updated to this code, there is a chance that a large amount of data could be pasted in and after testing with both versions of the code the 2nd one seems to run quicker than the 1st. They both work, so thank you to both of you for all the assistance.

Phil

 

[philwojo]

Re: How to use VBA to check cell length and set Horizontal Text Alingment

OK, one bit of feedback on this 2nd set of code. After I do a paste in to the sheet, if I type something in and hit <enter> to exit the cell I get a "Run-Time error '424': Object required" messaage and it points back to the 'For Each c In...." line of the code.

Here is how I have my code just to be specific.

Sub Worksheet_Change(ByVal Target As Range)  Dim c As Range

  For Each c In Intersect(Target, Range("B7:B6000"))
    c.HorizontalAlignment = IIf(Len(c.Value) > 10, xlJustify, xlCenter)
  Next c
            
End Sub

Any suggestions?</enter>

 

[Rick Rothstein]

Re: How to use VBA to check cell length and set Horizontal Text Alingment

OK, one bit of feedback on this 2nd set of code. After I do a paste in to the sheet, if I type something in and hit <enter> to exit the cell I get a "Run-Time error '424': Object required" messaage and it points back to the 'For Each c In...." line of the code.

My fault... I forgot to move the intersect test outside of the For..Next loop. This should work correctly...

[table="width: 500"]
[tr]
	[td]Sub Worksheet_Change(ByVal Target As Range)

  Dim c As Range
  
  If Not Intersect(Target, Range("B7:B6000")) Is Nothing Then
    For Each c In Intersect(Target, Range("B7:B6000"))
      c.HorizontalAlignment = IIf(Len(c.Value) > 10, xlJustify, xlCenter)
    Next c
  End If

End Sub[/td]
[/tr]
[/table]

Just to clarify, the difference between this version and Eric's original version is how many cells are iterated when a larger range of values is pasted. Let's assume you copy the range A:C from some other sheet and paste it into the same columns on the sheet the above event code is covering... Eric's code would iterate every cell in Columns A:C (all 3145728 of them), whereas the above code would only iterate the cells with the range being monitored (only 5994 of them).

In looking at the code again, I see what may be a "flaw". If any of the cells being pasted into the range B7:B6000 are blank, they will still be center aligned horizontally even though there is not text in them to align. That may be what you want, I don't know, but I would think simply skipping over a blank cell and giving it no alignment would be more logical. If you agree, here is the code to do that...

[table="width: 500"]
[tr]
	[td]Sub Worksheet_Change(ByVal Target As Range)

  Dim c As Range
  
  If Not Intersect(Target, Range("B7:B6000")) Is Nothing Then
    For Each c In Intersect(Target, Range("B7:B6000"))
      [B][COLOR="#0000FF"]If Len(c) Then [/COLOR][/B]c.HorizontalAlignment = IIf(Len(c.Value) > 10, xlJustify, xlCenter)
    Next c
  End If

End Sub[/td]
[/tr]
[/table]