Excel macro auto fil cell help, please!

[picok]

Dear! I need help with excel.
I have a mail database with approximately 5-10 columns and 100 - 50000 rows.
I sort them by postal code.
After that I give them autofits in height and width.
I add one row at the beginning.
Now i should somehow need all the colums in the first, empty,
row filled with AxxxxxA (This AxxxA is defined by the columne width but must start with A and ended with A)
But some colums have 3 letters and some 30.
How to make a macro for that?

 

[Fluff]

Whilst this will not do the sort, it should do the rest.
It assumes that
1) your data starts in A1.
2) you are using the default font & size.

Sub AddHeader()

    Dim Usdcols As Long
    Dim Qty As Long
    Dim Cl As Range
    Dim Cnt As Long
    
    Usdcols = Cells(1, Columns.Count).End(xlToLeft).column
    Rows(1).Insert
    ActiveSheet.UsedRange.EntireColumn.AutoFit
    For Each Cl In Range(Cells(1, 1), Cells(1, Usdcols))
        Qty = Cl.ColumnWidth
        Cl.Value = "A"
        For Cnt = 1 To Qty - 2
            Cl.Value = Cl.Value & "x"
        Next Cnt
        Cl.Value = Cl.Value & "A"
    Next Cl
    ActiveSheet.UsedRange.EntireRow.AutoFit
End Sub

Whilst the headers won't be a perfect fit, they should be pretty close.

 

[picok]

Thanks,that work great!

 

[Fluff]

Glad to help & thanks for the feedback

 

[Rick Rothstein]

Whilst this will not do the sort, it should do the rest.
It assumes that
1) your data starts in A1.
2) you are using the default font & size.

Sub AddHeader()

    Dim Usdcols As Long
    Dim Qty As Long
    Dim Cl As Range
    Dim Cnt As Long
    
    Usdcols = Cells(1, Columns.Count).End(xlToLeft).column
    Rows(1).Insert
    ActiveSheet.UsedRange.EntireColumn.AutoFit
    For Each Cl In Range(Cells(1, 1), Cells(1, Usdcols))
        Qty = Cl.ColumnWidth
        Cl.Value = "A"
        For Cnt = 1 To Qty - 2
            Cl.Value = Cl.Value & "x"
        Next Cnt
        Cl.Value = Cl.Value & "A"
    Next Cl
    ActiveSheet.UsedRange.EntireRow.AutoFit
End Sub

Whilst the headers won't be a perfect fit, they should be pretty close.

Just noting that your code can be compacted somewhat...

[table="width: 500"]
[tr]
	[td]Sub AddHeader()
  Dim Cl As Range
  Rows(1).Insert
  ActiveSheet.UsedRange.EntireColumn.AutoFit
  For Each Cl In Intersect(Rows(1), ActiveSheet.UsedRange.EntireColumn)
    Cl.Value = "A" & String(Cl.ColumnWidth - 2, "x") & "A"
  Next
  ActiveSheet.UsedRange.EntireRow.AutoFit
End Sub[/td]
[/tr]
[/table]

 

[Fluff]

Thanks for that Rick
Don't think I've ever come across the String function before.
Definitely something to try & remember.

 

[Rick Rothstein]

Thanks for that Rick
Don't think I've ever come across the String function before.
Definitely something to try & remember.

The String function is similar to Excel's REPT function except that it is limited to a single character for repeating (if you pass it a longer text string, the first character of that text string will be used); however, that single character can be specified by its text value or its ASCII code.