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

 

[philwojo]

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

Thanks again, this fixed the issue and I implemented the 2nd version to skip blank cells as well.

I really appreciate all the assistance.

Phil

 

[philwojo]

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

Ok, since I'm still learning VBA I'm having some issues with figuring something out.

I changed how I am doing things and now I no longer have the users paste data on to this sheet, but rather into a 'raw data' sheet. I then use VBA code to move that raw data on to this sheet. But now this code doesn't seem to work as I don't think it is being triggered by an event any longer.

I tried to take this same code and put it in a module and do a call from another macro to run it, but then it breaks that macro.

How can I update this to be a workbook macro (module), and sorry if I am messing up terminology, so I can call it from another macro to have it run?

Thanks,
phil

 

[Rick Rothstein]

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

Ok, since I'm still learning VBA I'm having some issues with figuring something out.

I changed how I am doing things and now I no longer have the users paste data on to this sheet, but rather into a 'raw data' sheet. I then use VBA code to move that raw data on to this sheet. But now this code doesn't seem to work as I don't think it is being triggered by an event any longer.

I tried to take this same code and put it in a module and do a call from another macro to run it, but then it breaks that macro.

How can I update this to be a workbook macro (module), and sorry if I am messing up terminology, so I can call it from another macro to have it run?

With you new way of doing things, will there be data on the worksheet when your code posts its data to that sheet or is your code posting its data to blank worksheet?

Also, what are the names of the sheet being copied to (your "raw data" sheet) and the sheet your code posts its output to?

 

[philwojo]

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

Here is my current code for doing this now:

Sub CopyRawdata()

Worksheets("PIF File Checker").Activate
Call Clearcells


Worksheets("Raw Data").Activate
Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row).Copy Sheets("PIF File Checker").Range("B7")
   
Worksheets("PIF File Checker").Activate
Call Text2ColSplit
End Sub

Here are the other 2 "Calls"

Sub Clearcells()

Application.EnableEvents = False


Range("B7", "BF6000").ClearContents
Cells(7, 2).Select


Application.EnableEvents = True
End Sub



Sub Text2ColSplit()
    Worksheets("PIF File Checker").Activate
    
    Range("b7:bf6000").NumberFormat = "@"
    
    Range("b7:b6000").TextToColumns _
      Destination:=Range("b7:b6000"), _
      DataType:=xlDelimited, _
      TextQualifier:=xlDoubleQuote, _
      ConsecutiveDelimiter:=False, _
      Comma:=True, _
        FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2), Array(5, 2), Array(6, 2), _
        Array(7, 2), Array(8, 2), Array(9, 2), Array(10, 2), Array(11, 2), Array(12, 2), Array(13, 2 _
        ), Array(14, 2), Array(15, 2), Array(16, 2), Array(17, 2), Array(18, 2), Array(19, 2), Array _
        (20, 2), Array(21, 2), Array(22, 2), Array(23, 2), Array(24, 2), Array(25, 2), Array(26, 2), _
        Array(27, 2), Array(28, 2), Array(29, 2), Array(30, 2), Array(31, 2), Array(32, 2), Array( _
        33, 2), Array(34, 2), Array(35, 2), Array(36, 2), Array(37, 2), Array(38, 2), Array(39, 2), _
        Array(40, 2), Array(41, 2), Array(42, 2), Array(43, 2), Array(44, 2), Array(45, 2), Array( _
        46, 2), Array(47, 2), Array(48, 2), Array(49, 2), Array(50, 2), Array(51, 2), Array(52, 2), _
        Array(53, 2), Array(54, 2), Array(55, 2), Array(56, 2), Array(57, 2))


End Sub

 

[philwojo]

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

With you new way of doing things, will there be data on the worksheet when your code posts its data to that sheet or is your code posting its data to blank worksheet?

Also, what are the names of the sheet being copied to (your "raw data" sheet) and the sheet your code posts its output to?

The worksheet the data will be moved too will have the cell contents cleared first and then the data moved to it.

 

[philwojo]

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

Rick, or anyone else, I'm still hoping to get this to work, it isn't critical for my Workbook, but it would be nice to have this function again.

Any assistance would be greatly appreciated.

Phil

 

[philwojo]

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

OK, I know there is a way better way to do this for a range of cells, but I'm still working my want through this so I'm not really sure, here is what I have and it works now, but only for 2 cells.

F27 = Range("F27").ValueIf Len(F27) >= textlen Then
Range("F27").HorizontalAlignment = xlFill
Else
Range("F27").HorizontalAlignment = xlCenter
End If




F29 = Range("F29").Value
If Len(F29) >= textlen Then
Range("F29").HorizontalAlignment = xlFill
Else
Range("F29").HorizontalAlignment = xlCenter
End If

How can I make this work for all cells between F3:f59 ?

I know there is a with loop or something I can do, but I just haven't spent enough time to figure it out yet.

Thanks for any help, I apologize if this is super basic, I'm trying to learn, but can't bring this home from work with me and while at work don't have a lot of time to search and learn.

Here is my full code, which I know is a mess, maybe I can get this cleaned up also, but I really have no way of working my way through this part to be honest, so I'll post and would love to look over any answers to try and learn how to make this better.

Sub CopyTranspose()Dim D29 As String, D30 As String, D31 As String, D32 As String, D33 As String, textlen As Integer
Dim E29 As String, E30 As String, E31 As String, E32 As String, E33 As String
Dim F29 As String, F30 As String, F31 As String, F32 As String, F33 As String
Dim G29 As String, G30 As String, G31 As String, G32 As String, G33 As String
Dim H29 As String, H30 As String, H31 As String, H32 As String, H33 As String
Dim F27 As String






Application.ScreenUpdating = False


Worksheets("PIF>BATCH").Activate
Range("D3", "H59").ClearContents
Range("D31", "H31").Interior.Color = vbWhite
Range("D32", "H32").Interior.TintAndShade = -0.249977111117893
Range("D6", "H6").Interior.TintAndShade = -0.249977111117893
Range("D22", "H22").Interior.TintAndShade = -0.249977111117893
Range("D46", "H46").Interior.TintAndShade = -0.249977111117893
Range("D48", "H48").Interior.TintAndShade = -0.249977111117893
Range("D33", "H33").Interior.Color = vbWhite


' With Range("D27", "H33")
'   .HorizontalAlignment = xlJustify
'    .VerticalAlignment = xlCenter
'End With




With Range("D31", "H33")
    .Font.Bold = False
    .Font.Color = vbBlack
    .Borders.LineStyle = xlContinuous
    .Borders.Weight = xlThin
    .Borders.ColorIndex = xlAutomatic
 '   .HorizontalAlignment = xlJustify
 '   .VerticalAlignment = xlCenter
End With


textlen = 40


D29 = Range("D29").Value
D30 = Range("D30").Value
D31 = Range("D31").Value
D32 = Range("D32").Value
D33 = Range("D33").Value


E29 = Range("E29").Value
E30 = Range("E30").Value
E31 = Range("E31").Value
E32 = Range("E32").Value
E33 = Range("E33").Value


F29 = Range("F29").Value
F30 = Range("F30").Value
F31 = Range("F31").Value
F32 = Range("F32").Value
F33 = Range("F33").Value


G29 = Range("G29").Value
G30 = Range("G30").Value
G31 = Range("G31").Value
G32 = Range("G32").Value
G33 = Range("G33").Value


H29 = Range("H29").Value
H30 = Range("H30").Value
H31 = Range("H31").Value
H32 = Range("H32").Value
H33 = Range("H33").Value






Worksheets("PIF File Checker").Range("b7:BF7").Copy
Worksheets("PIF>BATCH").Range("D3").PasteSpecial _
    Paste:=xlPasteValues, _
    Transpose:=True
    
Worksheets("PIF File Checker").Range("b8:BF8").Copy
Worksheets("PIF>BATCH").Range("E3").PasteSpecial _
    Paste:=xlPasteValues, _
    Transpose:=True
    
Worksheets("PIF File Checker").Range("b9:BF9").Copy
Worksheets("PIF>BATCH").Range("F3").PasteSpecial _
    Paste:=xlPasteValues, _
    Transpose:=True
    
F27 = Range("F27").Value
If Len(F27) >= textlen Then
Range("F27").HorizontalAlignment = xlFill
MsgBox "F27 greater than (40) = " & Len(F27), vbInformation
Else
Range("F27").HorizontalAlignment = xlCenter
MsgBox "F27 NOT greater than " & Len(F27), vbInformation
End If




F29 = Range("F29").Value
If Len(F29) >= textlen Then
Range("F29").HorizontalAlignment = xlFill
MsgBox "F29 greater than(40) = " & Len(F29), vbInformation
Else
Range("F29").HorizontalAlignment = xlCenter
MsgBox "F29 NOT greater than " & Len(F29), vbInformation
End If


    
    
Worksheets("PIF File Checker").Range("b10:BF10").Copy
Worksheets("PIF>BATCH").Range("G3").PasteSpecial _
    Paste:=xlPasteValues, _
    Transpose:=True
    
Worksheets("PIF File Checker").Range("b11:BF11").Copy
Worksheets("PIF>BATCH").Range("H3").PasteSpecial _
    Paste:=xlPasteValues, _
    Transpose:=True
    
Worksheets("PIF>BATCH").Activate


If Len(D29) >= textlen Then
Range("D29").HorizontalAlignment = xlFill
Else
Range("D29").HorizontalAlignment = xlCenter
End If


If Len(D30) >= textlen Then
Range("D30").HorizontalAlignment = xlFill
Else
Range("D30").HorizontalAlignment = xlCenter
End If


If Len(D31) >= textlen Then
Range("D31").HorizontalAlignment = xlFill
Else
Range("D31").HorizontalAlignment = xlCenter
End If


If Len(D32) >= textlen Then
Range("D32").HorizontalAlignment = xlFill
Else
Range("D32").HorizontalAlignment = xlCenter
End If


If Len(D33) >= textlen Then
Range("D33").HorizontalAlignment = xlFill
Else
Range("D33").HorizontalAlignment = xlCenter
End If


If Len(E29) >= textlen Then
Range("E29").HorizontalAlignment = xlFill
Else
Range("E29").HorizontalAlignment = xlCenter
End If


If Len(E30) >= textlen Then
Range("E30").HorizontalAlignment = xlFill
Else
Range("E30").HorizontalAlignment = xlCenter
End If


If Len(E31) >= textlen Then
Range("E31").HorizontalAlignment = xlFill
Else
Range("E31").HorizontalAlignment = xlCenter
End If


If Len(E32) >= textlen Then
Range("E32").HorizontalAlignment = xlFill
Else
Range("E32").HorizontalAlignment = xlCenter
End If


If Len(E33) >= textlen Then
Range("E33").HorizontalAlignment = xlFill
Else
Range("E33").HorizontalAlignment = xlCenter
End If


If Len(F29) >= textlen Then
Range("F29").HorizontalAlignment = xlFill
Else
Range("F29").HorizontalAlignment = xlCenter
End If


If Len(F30) >= textlen Then
Range("F30").HorizontalAlignment = xlFill
Else
Range("F30").HorizontalAlignment = xlCenter
End If


If Len(F31) >= textlen Then
Range("F31").HorizontalAlignment = xlFill
Else
Range("F31").HorizontalAlignment = xlCenter
End If


If Len(F32) >= textlen Then
Range("F32").HorizontalAlignment = xlFill
Else
Range("F32").HorizontalAlignment = xlCenter
End If


If Len(F33) >= textlen Then
Range("F33").HorizontalAlignment = xlFill
Else
Range("F33").HorizontalAlignment = xlCenter
End If


If Len(G29) >= textlen Then
Range("G29").HorizontalAlignment = xlFill
Else
Range("G29").HorizontalAlignment = xlCenter
End If


If Len(G30) >= textlen Then
Range("G30").HorizontalAlignment = xlFill
Else
Range("G30").HorizontalAlignment = xlCenter
End If


If Len(G31) >= textlen Then
Range("G31").HorizontalAlignment = xlFill
Else
Range("G31").HorizontalAlignment = xlCenter
End If


If Len(G32) >= textlen Then
Range("G32").HorizontalAlignment = xlFill
Else
Range("G32").HorizontalAlignment = xlCenter
End If


If Len(G33) >= textlen Then
Range("G33").HorizontalAlignment = xlFill
Else
Range("G33").HorizontalAlignment = xlCenter
End If


If Len(H29) >= textlen Then
Range("H29").HorizontalAlignment = xlFill
Else
Range("H29").HorizontalAlignment = xlCenter
End If


If Len(H30) >= textlen Then
Range("H30").HorizontalAlignment = xlFill
Else
Range("H30").HorizontalAlignment = xlCenter
End If


If Len(H31) >= textlen Then
Range("H31").HorizontalAlignment = xlFill
Else
Range("H31").HorizontalAlignment = xlCenter
End If


If Len(H32) >= textlen Then
Range("H32").HorizontalAlignment = xlFill
Else
Range("H32").HorizontalAlignment = xlCenter
End If


If Len(H33) >= textlen Then
Range("H33").HorizontalAlignment = xlFill
Else
Range("H33").HorizontalAlignment = xlCenter
End If


Cells(3, 4).Select


Application.ScreenUpdating = True


MsgBox "Raw data transferred successfully to both the" & Chr(10) & "'PIF File Checker' and 'PIF>BATCH' tabs!" & Chr(10) & "" & Chr(10) & "Check for highlighted cells that could indicate issues.", vbInformation


End Sub