Macro to adjust Row Height based on cell Character Count

[Jeffrey_1]

I have a 31,000 line spreadsheet, that will become a printed book. Based on the current column width (which has to stay the same for printing purposes) there are many lines that are only one line of text, and others that wrap to multiple lines. For some reason, for lines that are only one line (no wrapping needed) excel creates slightly larger padding below the text (even after auto fit), which creates a strange visual break (as if it's a new paragraph) and also makes the document longer than it needs to be because of the extra spacing. I'd like to get rid of that extra padding, but havn't found any solutions out there. I wondered if I could have a macro go through and adjust the column height to a specific height for any cells that contain fewer than a 90 characters (most of the one-line cells are under 100 characters, so I chose 90 to be safe). Any help would be enormously appreciated!

[Stuugie]

What specific height?

[Stuugie]

You'll have to adjust the sheet name, the cell numbers (wS1.cells(x,x)) and the RowHeight but the following will get you where you need to be.

Sub ShrinkToFit()

    Dim wS1 As Worksheet
    Dim aRng As Range
    Dim oC As Range

    Set wS1 = Worksheets("Sheet1")
    Set aRng = wS1.Range(wS1.Cells(2, 1), wS1.Cells(wS1.Rows.Count, 1).End(xlUp))

    For Each oC In aRng
        If Len(oC) <= 90 Then
            oC.EntireRow.RowHeight = 15
        Else
            oC.EntireRow.AutoFit
        End If
    Next oC

End Sub

[Stuugie]

I see you've come back to Daniweb well after I posted my last comment. Can you please let me know if that worked and if so mark the thread as solved?

It really is a common courtessy to those (like me) that take their own time to help others (like you) for free.

Thanks.

[Jeffrey_1]

It is working for a small sample of the text, but when I try to run it on the entire 31,000 lines of text, it just freezes. I'm trying to give it some time to see if it will work.

[Stuugie]

It's freezing because it's making a fair amount of changes to the layout of the sheet. I'm sorry, I should have turned off screen updating in the example I gave you.

Sub ShrinkToFit()
    Dim wS1 As Worksheet
    Dim aRng As Range
    Dim oC As Range

    Application.ScreenUpdating = False
    Set wS1 = Worksheets("Sheet1")
    Set aRng = wS1.Range(wS1.Cells(2, 1), wS1.Cells(wS1.Rows.Count, 1).End(xlUp))
    For Each oC In aRng
        If Len(oC) <= 90 Then
            oC.EntireRow.RowHeight = 15
        Else
            oC.EntireRow.AutoFit
        End If
    Next oC
    Application.ScreenUpdating = True

End Sub

[Jeffrey_1]

Thanks, I'll give it a shot and let you know.

[Jeffrey_1]

I tried it, and it did run, but took 11 hours to complete. I need to make a few more formatting changes now that I see how it turned out and then try again. Is there a faster way to do this? If not, I'll work with this. Thanks!

[Stuugie]

I just tested this code on 150,000 lines and it took about 20 seconds. I'm not sure why it's taking so long with your workbook. Do you have a bunch of calculations going on on the sheet in question?

[Jeffrey_1]

I have a bunch of conditional formats. I will try removing them and try again

[Stuugie]

Try shutting off sheet calculations in the procedure:

Sub ShrinkToFit()

    Dim wS1 As Worksheet
    Dim aRng As Range
    Dim oC As Range

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Set wS1 = Worksheets("Sheet1")
    Set aRng = wS1.Range(wS1.Cells(2, 1), wS1.Cells(wS1.Rows.Count, 1).End(xlUp))
    For Each oC In aRng
        If Len(oC) <= 90 Then
            oC.EntireRow.RowHeight = 15
        Else
            oC.EntireRow.AutoFit
        End If
    Next oC

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

[Jeffrey_1]

Still taking forever; perhaps the autofit is taking longer for each line because each cell averages over 300 characters of text and there are three columns it has to consider?

[Stuugie]

Can you post the code you are using? If you had to change what I gave you, perhaps the problem lies somewhere in there. It shouldn't take that long.

[Jeffrey_1]

your new code worked in about 30 minutes this time, which I can work with. The code is the same you provided. I was wondering if this same code could be modified to adjust the row height based on whether or not the text wraps to a second row, so that I can shave off even more wasted space than by using a conservative character count?

[Stuugie]

Holy carp, 30 minutes? That's way too long imo. I'm really at a loss here because I just ran the exact same code on exactly 101,891 rows where there were character counts greater than 90, less than 90, and with text wraps to second, third, and fourth row and it took just over 6 seconds. I don't understand why it is taking so long on your end. Can you upload your workbook? Unless of course it contains private or sensitive data.

[Jeffrey_1]

Attached

[Jeffrey_1]

File is too big, 1 MB limit

[Stuugie]

Well if you want to send it to my email it can go to [e-mail]

[Jeffrey_1]

Try this link to my google drive. It is Macro enabled, if you prefer macro disabled let me know and I can change the format. https://drive.google.com/file/d/0BwLipYQOGBz1b2FNanEwNU9KdHc/edit?usp=sharing

[Stuugie]

Hi Jeffrey,

After looking at your file I have come to a couple conclusions about why it is taking so long. Firstly, it's looking at over 200,000 cells and checking for criteria for each one. While this shouldn't take too long, each row could possible make a change 7 times because your code is checking 7 columns.

Secondly, you'll never achieve your desired outcome because many cells down column A have a lot of text in them which will not allow the cell padding to lessen in say column E.

Can I ask, why are you treating Excel like a text editor, wouldn't Word be better suited?

[Jeffrey_1]

I tried Word, but it cant manage this much data in a table format like this. Not sure what other option I have than to use excel.

[Stuugie]

I'm not sure that there's an easy solution for you but I'm pretty sure that Excel probably isn't one. What format did it come in originallly?

[Jeffrey_1]

pdf. I had to use a lot of macros and work in excel to clean it up and organize it, now I'm trying to get it printed in as few pages as possible without having too small of font. I figure the only room I have to play with is cell padding.