VBA/Excel/Access/Word/Excel/Column

Adjusting Column Widths

 
Sub AdjustColumns()
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    ws.Columns.ColumnWidth = 12
    Set ws = Nothing
End Sub

Array to Columns

 
Sub ArrayToColumns()
    Dim MyArray()
    Dim Cols As Integer
    Cols = 5
    ReDim MyArray(1 To Cols)
    Cells.Clear
    i = 1
    For c = 1 To Cols
        MyArray(c) = i
        i = i + 1
    Next c
    Range(Cells(1, 1), Cells(1, Cols)) = MyArray
End Sub

Assign the column width of one cell to another cell on the active sheet, using:

 
Sub widthDemo()
     Range("C1").ColumnWidth = Range("A1").ColumnWidth
End Sub

Assign the value to the ColumnWidth property of the ActiveCell using:

 
Sub colDemo()
     ActiveCell.ColumnWidth = 20
End Sub

Change column width

 
Private Sub ChangeColumnWidth(Width As Variant) 
    If IsNumeric(Width) Then 
        If Width > 0 And Width < 100 Then 
            Me.Columns.ColumnWidth = Width 
        ElseIf Width = 0 Then 
            Me.Columns.ColumnWidth = Me.StandardWidth 
        End If 
    End If 
End Sub

ClearContents method deletes the contents of the range but leaves the formatting intact.

 
Sub content()
    Columns("D:D").ClearContents
End Sub

ClearFormats method deletes the formatting in the range but not the cell contents.

 
Sub format()
    Columns("D:D").ClearFormats
End Sub

converts the Integer to a String representation of the same column.

 
Sub Main()
   Debug.Print GetColumnRef(3)
End Sub
Function GetColumnRef(columnIndex As Integer) As String
    Dim numAlpha As Integer
    Dim firstLetter As String
    Dim secondLetter As String
    Dim remainder As Integer
    numAlpha = columnIndex \ 26
    Select Case columnIndex / 26
        Case Is <= 1      "Column ref is between A and Z
            firstLetter = Chr(columnIndex + 64)
            GetColumnRef = firstLetter
        Case Else      "Column ref has two letters
            remainder = columnIndex - 26 * (columnIndex \ 26)
            If remainder = 0 Then
                firstLetter = Chr(64 + (columnIndex \ 26) - 1)
                secondLetter = "Z"
                GetColumnRef = firstLetter & secondLetter
            Else
                firstLetter = Chr(64 + (columnIndex \ 26))
                secondLetter = Chr(64 + remainder)
                GetColumnRef = firstLetter & secondLetter
            End If
    End Select
End Function

Is in last column

 
Function LASTINCOLUMN(rngInput As Range)
    Dim WorkRange As Range
    Dim i As Integer, CellCount As Integer
    Application.Volatile
    Set WorkRange = rngInput.Columns(1).EntireColumn
    Set WorkRange = Intersect(WorkRange.Parent.UsedRange, WorkRange)
    CellCount = WorkRange.Count
    For i = CellCount To 1 Step -1
        If Not IsEmpty(WorkRange(i)) Then
            LASTINCOLUMN = WorkRange(i).Value
            Exit Function
        End If
    Next i
End Function

Make a range autofit

 
Sub autofit()
    range("A1:G1").Columns.autofit
End Sub

Returning the Last Used Cell in a Column or Row with Worksheet

 
Function GetLastUsedRow(rg As Range) As Long 
    Dim lMaxRows As Long 
    lMaxRows = ThisWorkbook.Worksheets(1).Rows.Count 
    If IsEmpty(rg.Parent.Cells(lMaxRows, rg.Column)) Then 
        GetLastUsedRow = _ 
            rg.Parent.Cells(lMaxRows, rg.Column).End(xlUp).Row 
    Else 
        GetLastUsedRow = rg.Parent.Cells(lMaxRows, rg.Column).Row 
    End If 
End Function

Select active column

 
Sub SelectActiveColumn()
    If IsEmpty(ActiveCell) Then Exit Sub
    On Error Resume Next
    If IsEmpty(ActiveCell.Offset(-1, 0)) Then Set TopCell = ActiveCell Else Set TopCell = ActiveCell.End(xlUp)
    If IsEmpty(ActiveCell.Offset(1, 0)) Then Set BottomCell = ActiveCell Else Set BottomCell = ActiveCell.End(xlDown)
    Range(TopCell, BottomCell).Select
End Sub

Select entire column

 
Sub SelectEntireColumn()
    Selection.EntireColumn.Select
End Sub

Select first column to last column

 
Sub SelectFirstToLastInColumn()
    Set TopCell = Cells(1, ActiveCell.Column)
    Set BottomCell = Cells(16384, ActiveCell.Column)
    If IsEmpty(TopCell) Then Set TopCell = TopCell.End(xlDown)
    If IsEmpty(BottomCell) Then Set BottomCell = BottomCell.End(xlUp)
    If TopCell.Row = 16384 And BottomCell.Row = 1 Then ActiveCell.Select Else Range(TopCell, BottomCell).Select
End Sub

The BubbleSort() procedure sorts a column of integer values from lowest to highest value

 
Public Sub BubbleSort()
    Dim tempVar As Integer
    Dim anotherIteration As Boolean
    Dim I As Integer
    Do
        anotherIteration = False
        For I = 1 To 9
            If Cells(I, "A").Value > Cells(I + 1, "A").Value Then
                tempVar = Cells(I, "A").Value
                Cells(I, "A").Value = Cells(I + 1, "A").Value
                Cells(I + 1, "A").Value = tempVar
                anotherIteration = True
            End If
        Next I
    Loop While anotherIteration = True
End Sub

The Clear method

 
Sub clear()
    Columns("D:D").clear
End Sub

The NumberFormat property represents the number format (expressed as a text string) of the Range object: statement changes the number format of column A to percent with two decimal places

 
Sub numFormat()
    Columns("A:A").NumberFormat = "0.00%"
End Sub