Macro Improvement on Execution Time

[tyija1995]

Hi all,

I have made a macro at work to basically calculate the maximum length (of a cell) for each column in a table with header row 1 (used for SQL truncation purposes... I.e. "Job Title" may have type nvarchar(20))

The macro works all well and good but it can be pretty slow when dealing with high quantities of data, so I was wondering if there were any improvements I can make to the code?

Here is a very short example:

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Job Title[/TD]
[TD]Description[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Cleaner[/TD]
[TD]Cleans the office[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Data Analyst[/TD]
[TD]Analyses data in SQL databases[/TD]
[/TR]
</tbody>[/TABLE]

If I execute the macro on this table of data above I get:

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Job Title[/TD]
[TD]Description[/TD]
[TD][/TD]
[TD]Field Name[/TD]
[TD]Max Length[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Cleaner[/TD]
[TD]Cleans the office[/TD]
[TD][/TD]
[TD]Job Title[/TD]
[TD]12[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Data Analyst[/TD]
[TD]Analyses data in SQL databases[/TD]
[TD][/TD]
[TD]Description[/TD]
[TD]30[/TD]
[/TR]
</tbody>[/TABLE]

So my question really is how can I improve on the code I have written for speed purposes?

Sub MaxLength()
Application.ScreenUpdating = False
Dim i As Long, j As Long, lastRow As Long, lastCol As Long, maxLen As Long, lastDelRow As Long
lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
On Error Resume Next
For j = 1 To lastCol
    lastRow = Cells(Rows.Count, j).End(xlUp).Row
        For i = 2 To lastRow
            Cells(i, lastCol + 1) = Len(Cells(i, j))
        Next i
            maxLen = WorksheetFunction.Max(Range(Cells(2, lastCol + 1), Cells(lastRow, lastCol + 1)))
    Cells(1, lastCol + 2).Value = "Field Name"
    Cells(1, lastCol + 3).Value = "Max Length"
    Cells(j + 1, lastCol + 2).Value = Cells(1, j)
    Cells(j + 1, lastCol + 3).Value = maxLen
Next j


lastDelRow = Cells(Rows.Count, lastCol + 1).End(xlUp).Row
Range(Cells(2, lastCol + 1), Cells(lastDelRow, lastCol + 1)).Clear
Range(Cells(1, lastCol + 2), Cells(Cells(Rows.Count, lastCol + 2).End(xlUp).Row, lastCol + 3)).Columns.AutoFit
Range(Cells(1, lastCol + 2), Cells(Cells(Rows.Count, lastCol + 2).End(xlUp).Row, lastCol + 3)).Select
Application.ScreenUpdating = True


End Sub

I hope this makes sense, as I say it works fine but it is quite slow with larger tables of data.

Thanks for any responses!

 

[jkpieterse]

Wouldn't this simple (array entered, so use control+shift+enter) formula work:

=MAX(LEN(A2:A100))

Of course you'll have to adjust the range.

 

[tyija1995]

Hey, that would return me the max length overall, I need max length per column, so essentially MAX(LEN(A2:A100)) & MAX(LEN(B2:B100)) & ... & MAX(LEN(N2:N100)) for example if I had 14 columns with 100 rows, e.g. I might have a postcode column and I need to see if any are other 20 characters for example, in which case I need to truncate in SQL.

 

[tyija1995]

Apologies, I misread the formula you put thinking it would be A2:N100 for example, I see what you mean now and yes it would work! Thank you i'll make a macro to do this array formula !

 

[Rick Rothstein]

Give this macro a try...

[table="width: 500"]
[tr]
	[td]Sub MaxLengths()
  Dim R As Long, LastRow As Long, LastCol As Long
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
  Application.ScreenUpdating = False
  Cells(1, LastCol + 2).Value = "Field Name"
  For R = 1 To LastCol
    Cells(R + 1, LastCol + 2).Value = Cells(1, R).Value
    Cells(R + 1, LastCol + 3).Value = Evaluate("MAX(LEN(" & Cells(2, R).Address & ":" & Cells(LastRow, R).Address & "))")
  Next
  Application.ScreenUpdating = True
End Sub[/td]
[/tr]
[/table]

 

[tyija1995]

Hi Rick,

Thank you for your post - I have since made a macro that executes a lot faster than my old one posted, in addition I have tested your macro and it works at approximately the same speed as my new one, needless to say I am happy with the results of both and appreciate the post! Now I should be able to confidently show this to my colleagues at work as it isn't super slow anymore :D