VBA/Excel/Access/Word/Excel/ActiveCell

Accesses the PROPER( ) function through the Application.WorksheetFunction object.

 
     Sub FixText()
        ActiveCell.Value = Application.WorksheetFunction.Proper("asdf")
     End Sub

Activate Change

 
Sub DownTen()
   ActiveCell.Offset(10, 0).Select
End Sub

Activate Next Blank Down

 
Sub ActivateNextBlankDown()
    ActiveCell.Offset(1, 0).Select
    Do While Not IsEmpty(ActiveCell)
        ActiveCell.Offset(1, 0).Select
    Loop
End Sub

Activate Next Blank To Right

 
Sub ActivateNextBlankToRight()
    ActiveCell.Offset(0, 1).Select
    Do While Not IsEmpty(ActiveCell)
        ActiveCell.Offset(0, 1).Select
    Loop
End Sub

a Do-Loop Until loop with IsEmpty

 
Sub DoLoopUntilDemo()
    Do
        ActiveCell.value = ActiveCell.value * 2
        ActiveCell.offset(1, 0).Select
    Loop Until IsEmpty(ActiveCell.value)
End Sub

Check the existence of ActiveCell

 
Sub activeCell()
    If ActiveCell Is Nothing Then End
End Sub

Copy the value from the variable into the cell on the right.

 
     Sub SwapTextWithCellOnRight()
         Dim CellContent
         CellContent = ActiveCell.Value
         ActiveCell.Offset(0, 1).Value = CellContent
     End Sub

Do-Until loop and IsEmpty

 
Sub DoUntilDemo()
    Do Until IsEmpty(ActiveCell.value)
        ActiveCell.value = ActiveCell.value * 2
        ActiveCell.offset(1, 0).Select
    Loop
End Sub

Do-While loop with ActiveCell

 
Sub DoWhileDemo()
    Do While ActiveCell.value <> Empty
        ActiveCell.value = ActiveCell.value * 2
        ActiveCell.offset(1, 0).Select
    Loop
End Sub

Entering a Formula in a Cell

 
"Enters the formula =SUM($G$12:$G$22) in the active cell:
Sub fomula()
    ActiveCell.Formula = "=SUM($G$12:$G$22)"
End Sub

Entering Text in the Current Cell

 
Sub MyMacro
   ActiveCell.Value = "Hello World!"
End Sub

Get the address of ActiveCell

 
Sub selectRange()
    MsgBox ActiveCell.Address
End Sub

Go to the Max

 
Sub GoToMax()
    Dim WorkRange As Range
    If TypeName(Selection) <> "Range" Then Exit Sub
    If Selection.Count = 1 Then
        Set WorkRange = Cells
    Else
        Set WorkRange = Selection
    End If
    MaxVal = Application.Max(WorkRange)
    
    On Error Resume Next
    WorkRange.Find(What:=MaxVal, _
        After:=WorkRange.Range("A1"), _
        LookIn:=xlValues, _
        LookAt:=xlPart, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=False _
        ).Select
    If Err <> 0 Then MsgBox "Max value was not found: " _
     & MaxVal
End Sub

If the value of the active cell is too big, change it

 
     Sub MyMacro()
         If ActiveCell.Value > 100 Then
             ActiveCell.Value = 100
         End If
     End Sub

Moves the active cell up two rows (RowOffset:=-2) and four columns to the right (ColumnOffset:=4):

 
Sub offset()
    ActiveCell.Offset(RowOffset:=-2, ColumnOffset:=4).Activate
End Sub

Move the active cell by using ActiveCell.Offset

 
Sub ActivateNextBlankToRight()
    ActiveCell.Offset(0, 1).Select
    Do While Not IsEmpty(ActiveCell)
        ActiveCell.Offset(0, 1).Select
    Loop
End Sub

Move to the new cell, you need to use the Activate or Select method

 
     Sub MyMacro()
         " Change the top cell.
         ActiveCell.Value = "Top cell"
         " Move down one cell.
         ActiveCell.Offset(1, 0).Select
         " Now this changes the bottom cell.
         ActiveCell.Value = "Bottom cell"
     End Sub

Moving to Other Cells

 
     Sub MyMacro()
         ActiveCell.Value = "Top cell"
         ActiveCell.Offset(1, 0) = "Bottom cell"
     End Sub

Repeating Actions with a Loop

 
     Sub FormatAllCellsInColumn()
         Do Until ActiveCell.Value = ""
             ActiveCell.Rows.EntireRow.Select
             Selection.Interior.ColorIndex = 35
             Selection.Interior.Pattern = xlSolid
             ActiveCell.Offset(2, 0).Select
         Loop
     End Sub

Select ActiveCell and cells to its Left

 
Sub SelectToLeft()
    Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
End Sub

Select ActiveCell and cells to its Right

 
Sub SelectToRight()
    Range(ActiveCell, ActiveCell.End(xlToRight)).Select
End Sub

Select active cell and up to the end

 

Sub SelectUp()
    Range(ActiveCell, ActiveCell.End(xlUp)).Select
End Sub

Select ActiveCell"s range

 
Sub SelectCurrentRegion()
    ActiveCell.CurrentRegion.Select
End Sub

Select Current Region

 
Sub SelectCurrentRegion()
    ActiveCell.CurrentRegion.Select
End Sub

Select First To Last In 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

Select First To Last In Row

 
Sub SelectFirstToLastInRow()
    Set LeftCell = Cells(ActiveCell.Row, 1)
    Set RightCell = Cells(ActiveCell.Row, 256)
    If IsEmpty(LeftCell) Then Set LeftCell = LeftCell.End(xlToRight)
    If IsEmpty(RightCell) Then Set RightCell = RightCell.End(xlToLeft)
    If LeftCell.Column = 256 And RightCell.Column = 1 Then ActiveCell.Select Else Range(LeftCell, RightCell).Select
End Sub

Store the location of the active cell and then return it to the stored location

 
Sub set()
    Set myActiveCell = ActiveCell
    Set myActiveWorksheet = ActiveSheet
    Set myActiveWorkbook = ActiveWorkbook
    
    "take actions here
    
    myActiveWorkbook.Activate
    myActiveWorksheet.Activate
    myActiveCell.Activate
End Sub

Swap Text With Cell On Right

 
     Sub SwapTextWithCellOnRight()
         Dim CellContent
         CellContent = ActiveCell.Value
         ActiveCell.Value = ActiveCell.Offset(0, 1).Value
     End Sub

Take the current text value, and add the message "INVALID: " before the text

 
Sub MyMacro
         ActiveCell.Value = "INVALID: " & ActiveCell.Value
End Sub

Toggles text wrap alignment for selected cells

 
Sub ToggleWrapText()
    If TypeName(Selection) = "Range" Then
      Selection.WrapText = Not ActiveCell.WrapText
    End If
End Sub

Use ActiveCell.Offset to move the curren selection

 
Sub ActivateNextBlankDown()
    ActiveCell.Offset(1, 0).Select
    Do While Not IsEmpty(ActiveCell)
        ActiveCell.Offset(1, 0).Select
    Loop
End Sub

Use ActiveCell.SpecialCells(xlLastCell)

 
Sub SelectActiveArea()
    Range(Range("A1"), ActiveCell.SpecialCells(xlLastCell)).Select
End Sub

Use all the ordinary numeric operators, like +, -, /, *, and ^.

 
Sub MyMacro
         ActiveCell.Value = (ActiveCell.Value * 2) - 1
End Sub

Use Do Loop While to change ActiveCell value

 
Sub DoLoopWhileDemo()
    Do
        ActiveCell.value = ActiveCell.value * 2
        ActiveCell.offset(1, 0).Select
    Loop While ActiveCell.value <> Empty
End Sub

Use if, ElseIf and Else with ActiveCell

 
     Sub MyMacro()
         If ActiveCell.Value > 1000 Then
             ActiveCell.Offset(0, 1).Value = ActiveCell.Value * 0.05
         ElseIf ActiveCell.Value > 500 Then
             ActiveCell.Offset(0, 1).Value = ActiveCell.Value * 0.025
         Else
             ActiveCell.Offset(0, 1).Value = 5
         End If
     End Sub

Uses the EntireColumn property, which returns a Range object that consists of a full column:

 
Sub SelectColumn()
    ActiveCell.EntireColumn.Select
End Sub

Working with the Region around the Active Cell

 
Sub font()
    With ActiveCell.CurrentRegion.Font
        .Name = "Times New Roman"
        .Size = 12
        .Bold = False
        .Italic = False
    End With
End Sub