Lock Excel column width

Solved
Hello,

I would like to know if it is possible to lock a column width?

Let me explain:

I have an Excel workbook with different tabs and tables in each tab. In these tabs, users enter their data into the tables.

Then I run an update with a macro button in Excel that selects the tables I have specified and displays them one after the other in a special tab. All the tables have the same structure!

So I would like to set the column widths (different for each column) and have them locked permanently. So that with each update I don't have to re-enter all the column widths.

I hope I have been clear. If you need more info, feel free to ask!

Thanks in advance. ;)

Configuration: Windows XP / Internet Explorer 6.0

--
"But how to do it,
How to tell him,
How to make him see,
My planet,
Artificial..."

-M-

1 answer

  1. Contributor
    Hello,

    Either you protect the sheet, or you redefine the column widths in your macro.

    eric
    -1
    1. I'm not very good at macros.
      Could you give me a little example?

      Thanks in advance.
      0
    2. Contributor
      Re,

      example:
      Sub columnWidths() Dim width As Variant, col As Long width = Array(15, 25, 8) ' column widths in a table For col = 2 To 4 ' starting from column 2 Columns(col).ColumnWidth = width(col - 2) Next col End Sub

      eric
      0
    3. It doesn't seem to be working, I would like to define the width of each column if possible.

      Here is my program, where can I insert yours?

      Option Explicit
      Public Wks As Worksheet
      Const Name = "Process Analysis Synoptic"

      Public Sub CopyTB()
      Dim Row As Long, NumTB As Integer, Order As Integer
      Dim Range As Range, cell As Range
      Application.DisplayAlerts = False
      Application.ScreenUpdating = False
      Sheets(Name).Delete
      Set Wks = Sheets.Add
      Wks.Move After:=Sheets("synoptic")
      Wks.Name = Name
      With Sheets("synoptic")
      Set Range = .Range("B19:B" & .Cells(.Rows.Count, 2).End(xlUp).Row)
      'Count the number of TB to copy
      For Each cell In Range
      If cell <> "" Then NumTB = NumTB + 1
      Next cell
      If NumTB = 0 Then Exit Sub 'no selection found
      For Row = 1 To NumTB
      For Each cell In Range
      If cell = Row Then
      CopyOneTB cell
      End If
      Next cell
      Next Row
      End With
      Wks.Select
      Set Wks = Nothing
      Application.DisplayAlerts = True
      End Sub

      Sub CopyOneTB(cell As Range)
      Dim TB, NextRow As Long
      TB = Split(cell.Offset(0, 1), "/")
      With Sheets(Trim(TB(0)))
      NextRow = Wks.Range("A1").SpecialCells(xlCellTypeLastCell).Row + 1
      .Range("A10:" & .Range("A1").SpecialCells(xlCellTypeLastCell).Address).Copy Wks.Range("A" & NextRow)
      End With
      End Sub

      Thank you in advance
      0
    4. Contributor
      Where can I insert yours
      rather at the end of the procedure that you are calling.
      0
    5. And what do the numbers in your code correspond to?
      0