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]

Good evening and welcome to the Board

Please test the code below:

selecting the top-left-most cell in the range and the macro recognizes the named range

this can be done.

using a "hot key"

this can also be done.

Sub Format_Table()
Dim nr$, cw(), i%
nr = Application.InputBox("Enter range name:", "Choose range", , , , , , 2)     ' #1
Range(nr).ClearFormats                                                          ' #2
ReDim cw(1 To Range(nr).Columns.count)
For i = 1 To UBound(cw)
    cw(i) = Range(nr).Columns(i).ColumnWidth
Next
With ActiveSheet
    .ListObjects.Add(xlSrcRange, Range(nr), , xlYes).Name = "Table_" & nr
    .ListObjects("Table_" & nr).TableStyle = "TableStyleMedium2"
    .ListObjects("Table_" & nr).Unlist                                          ' #4
End With
For i = 1 To UBound(cw)
    Range(nr).Columns(i).ColumnWidth = cw(i)                                    ' #3
Next
With Range(nr)
    .Rows(1).Font.Bold = False                                                  ' #5
    .Rows(1).HorizontalAlignment = xlCenter
    .Range("a1") = ""                                                           ' #6
    .Columns(1).Font.Name = "Andalus"   ' choose a font here                    ' #7
End With
End Sub

 

[arv84]

Thanks so much for taking the time on this. This code accomplishes exactly what I need.

 

[Worf]

You are welcome and thanks for the feedback

 

[rlondon18]

Hello Worf,

First of all, congratulations for your answer - it was awesome.

Well, I need something easier than that:
1) A macro that starts asking for a table name
2) From the selected cell, select all the range (I've used ActiveCell.CurrentRegion.Select and worked)
3) Format as table style "Table Style Medium 6" with "My table has headers" selected.
4) Rename the table created with the table name from step1
5) Rename the sheet tab with the table name from step1 as well

Vendo que sua referência é Rio, imagino que seja carioca como eu.
Fiquei orgulhoso de ver um Brazuca respondendo em tão alto nível.
Conto com sua ajuda para resolver minha dúvida. Muito obrigado.

Thanks,
Rafael.

 

[rlondon18]

Hi again Worf,

Using your code and some minor changes I've got it:

Sub TrataTabela()
Dim nr$, cw(), i%
ActiveCell.CurrentRegion.Select
nr = Application.InputBox("Enter range name:")
With ActiveSheet
.ListObjects.Add(xlYes).Name = "T_" & nr
.ListObjects("T_" & nr).TableStyle = "TableStyleMedium6"
End With
ActiveSheet.Name = nr
End Sub

Thank you very much again!

Parabéns e um abraço,
Rafael.

 

[rlondon18]

Ops,

There is a flaw in my code...
My macro is creating new headers as Column1, Column2, Column3, Column"n"
Could you help?

Thanks,
Rafael.

 

[rlondon18]

Hello Worf,

Nothing like a good sleep night!
Now it's working charm:

Sub TrataTabela()
Dim nr$, cw(), i%
ActiveCell.CurrentRegion.Select
nr = Application.InputBox("Enter range name:")
With ActiveSheet
.ListObjects.Add(, , , xlYes).Name = "T_" & nr
.ListObjects("T_" & nr).TableStyle = "TableStyleMedium6"
End With
ActiveSheet.Name = nr
End Sub

Thanks & regards,
Rafael

 

[Worf]

Olá Rafael

I am glad it is working. Any further issues with this, post here.

 

[rlondon18]

Boa noite Worf,

Espero não estar infringindo nenhuma regra do MrExcel Forum escrevendo em portugues, mas fica mais fácil.
Como postei antes, tudo funciona bem e atendeu minha necessidade.
Só consegui solucionar me baseando no seu código - sem esta "cola" iria demorar muito para resolver.
Pensei em melhorias com tratamento de erros:
1) Quando nada tiver sido selecionado - msg "Selecionar célula dentro do intervalo da tabela"
2) O nome da planilha já existe - msg "Nome já existe!" - e voltar na tela para inserir um novo nome
3) Caso só tenha uma linha - msg "Dados insuficientes para criar tabela"
Enfim, minha idéia era blindar melhor o uso da macro.

Valeu mais uma vez,
Abs,
Rafael.