VBA Macro to format table range

[arv84]

Good afternoon,

I have the need to format many different ranges of cells into similarly formatted tables, and I was hoping to write a macro to satisfy this repetitive task. The ranges already have data in them based on formulas linked to pivot tables. I tried to record a macro with the key strokes for the formatting that I require, but I was not able to completely get it right. I ran into 2 issues: (1) I couldn't figure out how to scale the macro (ie - apply the macro to the cell ranges that I didn't actually record the macro in) and (2) The macro did not record all of the formatting nuances that I require. I am a finance guy with very little understanding of coding and VBA, but this is what i would like my macro to do:

(1) Select all cells in a named range (ie - I would like to run this macro by either selecting the range myself and then using a "hot key" to perform the formatting or by selecting the top-left-most cell in the range and the macro recognizes the named range from there when I execute the "hot key" - if that is even possible)
(2) Removing borders from the range and fillings range with "no fill"
(3) Format as table style "Table Style Medium 2" with "My table has headers" selected. At this point, the selected range usually expands the column widths to fit the column headers on one line. I would like column widths to remain the same as they were before I formatted as a table - if that is even possible
(4) Convert table to a range
(5) Remove bold font from headers and center headers within the cells
(6) Remove header in top-left-most cell (it automatically fills this in as "Column 1"
(7) Format entire first column of the table as "Accounting" font

Any help with this would be very helpful. Thanks in advance for any responses.

 

[Worf]

The “Excel Questions” section is English only. To post in other languages, use the “Questions in other languages” section.

Sub TrataTabela()
Dim nr$, r As Range, sn$
Set r = ActiveCell.CurrentRegion
If r.Cells.count = 1 Then
    MsgBox "Select a table cell", vbCritical, "Only one cell"
    Exit Sub
End If
If r.Rows.count = 1 Then
    MsgBox "Insufficient data", vbExclamation, "Only one row"
    Exit Sub
End If
On Error Resume Next
Do
    nr = Application.InputBox("Enter range name:", "Existing sheet names cannot be used!")
    sn = Sheets(nr).Name
Loop Until Err.Number <> 0
On Error GoTo 0
With ActiveSheet
    .ListObjects.Add(xlSrcRange, r, , xlYes).Name = "T_" & nr
    .ListObjects("T_" & nr).TableStyle = "TableStyleMedium6"
End With
ActiveSheet.Name = nr
End Sub