Assistance with checking cell length for a range of cells with VBA

philwojo

Well-known Member
Joined
May 10, 2013
Messages
533
Hello, I'm trying to write some code to loop through a range of cells and check each cell's length and then perform a function based on that. Here is what I have so far:

Code:
Sub CopyTranspose()

textlen As Integer, rng As Range, cell As Range

textlen = 36



With ThisWorkbook.Worksheets("PIF>BATCH")

Set rng = Range("D3", "H59")


For Each cell In rng


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

End Sub

I am getting a Runtime 1004 error "method 'range' of object '_Global' failed".

I am trying to muddle my way through things but I'm just not doing well it seems today.

I want to loop through each cell in the range of B3:H59 and check each cell length, if it is greater than 36 then change the Horizontal Alignment to be "Fill" if it is 36 or shorter set it to "Center".

Thanks,
Phil
 

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
Change Set rng = Range("D3", "H59")
to Set rng = Range("D3:H59")
 
Upvote 0
Code:
Sub CopyTranspose()
    Dim textlen As Integer, rng As Range, cell As Range
    textlen = 36
    With ThisWorkbook.Worksheets("PIF>BATCH")
        Set rng = .Range("D3:H59")
        For Each cell In rng
            If Len(cell.Value) >= textlen Then
                cell.HorizontalAlignment = xlFill
            Else
                cell.HorizontalAlignment = xlCenter
            End If
        Next cell
    End With
End Sub
 
Last edited:
Upvote 0
Thanks that works.

How can I update this to only check cell's that aren't blank and for a larger range, so it runs more efficiently? Say the range was B7:BF6000

And is it possible to change textlen to change based upon the columnwidth of the cell the loop is in rather than being static?
 
Last edited:
Upvote 0
Rich (BB code):
Sub CopyTranspose()
    Dim textlen As Integer, rng As Range, cell As Range
    textlen = 36
    With ThisWorkbook.Worksheets("PIF>BATCH")
        Set rng = .Range("B7:BF6000")
        For Each cell In rng
            If Len(cell.Value) >= textlen Then
                cell.HorizontalAlignment = xlFill
            ElseIf Len(cell.Value) > 0 Then
                cell.HorizontalAlignment = xlCenter
            End If
        Next cell
    End With
End Sub
 
Upvote 0
Thanks, I knew how to update the range, that I have no problem with.

I appreciate the extra ElseIf part, but it still seems to go through each of those cells so it kind of bogs down the workbook for a short bit.

This works, and it is better than what I had, totally, and I thank you for that, but is there a way to make it run quicker still, if not that is fine, just asking.
 
Upvote 0
So I'm trying this and it isn't working, the part in red and underlined in the code.

Code:
With ThisWorkbook.Worksheets("PIF>BATCH")

    Set rng = .Range("B7:B6000")
        
    For Each cell In rng


[COLOR=#ff0000][U][B]cnum = Range("rng").Columnwidth[/B][/U][/COLOR]
textlen = cnum
        
    If Len(cell.Value) >= textlen Then
        cell.HorizontalAlignment = xlFill
    ElseIf Len(cell.Value) > 0 Then
        cell.HorizontalAlignment = xlCenter
    End If
    Next cell
End With

How can I set texlen to be the Width of the column it is checking at the time from the range?
 
Upvote 0
Anyone have any feedback for me on this one?

I changed it to be
Code:
set cnum = Range("rng").ColumnWidth

But that made no difference.
 
Upvote 0
Ok, I got it working, here is what I ended up with:

Code:
With ThisWorkbook.Worksheets("PIF>Batch")

    Set rng = .Range("B7:BF6000")
        
    For Each cell In rng


textlen = cell.ColumnWidth
        
    If Len(cell.Value) >= textlen Then
        cell.HorizontalAlignment = xlFill
    ElseIf Len(cell.Value) > 0 Then
        cell.HorizontalAlignment = xlCenter
    End If
    Next cell
End With

It probably can be faster still but this is at least doing what I need it to do.

Thanks again to everyone on the boards for helping along the way.

Phil
 
Upvote 0

Forum statistics

Threads
1,213,504
Messages
6,114,020
Members
448,543
Latest member
MartinLarkin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top