VBA/Excel/Access/Word/Excel/Row

Array to rows

   <source lang="vb">

Sub ArrayToRows1()

   Dim MyArray()
   Dim Rows As Long
   Rows = 5200
   ReDim MyArray(1 To Rows)
   Cells.Clear
   i = 1
   For r = 1 To Rows
       MyArray(r) = i
       i = i + 1
   Next r
   Range(Cells(1, 1), Cells(Rows, 1)) = _
     Application.Transpose(MyArray)

End Sub

</source>
   
  

Array to rows - method (Limited to

   <source lang="vb">

Sub ArrayToRows2()

   Dim Rows As Long
   Dim MyArray()
   Rows = 65536
   ReDim MyArray(1 To Rows, 0 To 0)
   Cells.Clear
   i = 1
   For r = 1 To Rows
       MyArray(r, 0) = i
       i = i + 1
   Next r
   Range(Cells(1, 1), Cells(Rows, 1)) = MyArray

End Sub

</source>
   
  

Bold cells in a Row

   <source lang="vb">

Public Sub BoldCells()

 Dim Row As Object
 
 For Each Row In Range("SalesData").Rows
   If Row.Cells(1).Value > 1000 Then
     Row.Font.Bold = True
   Else
     Row.Font.Bold = False
   End If
 Next Row

End Sub

</source>
   
  

change row height

   <source lang="vb">

Private Sub ChangeRowHeight(Height As Variant)

   If IsNumeric(Height) Then
       If Height > 0 And Height < 100 Then
           Me.Rows.RowHeight = Height
       ElseIf Height = 0 Then
           Me.Rows.RowHeight = Me.StandardHeight
       End If
   End If

End Sub

</source>
   
  

Clearing a range differs from deleting a range. When you delete a range, Excel shifts the remaining cells around to fill up the range you deleted.

   <source lang="vb">

Sub delete()

   Rows("6:6").delete

End Sub

</source>
   
  

Delete empty rows

   <source lang="vb">

Sub DeleteEmptyRows()

 Dim rngRow As Range
 For Each rngRow In ActiveSheet.UsedRange.Rows
   If WorksheetFunction.CountA(rngRow) = 0 Then
     rngRow.EntireRow.Delete
   End If
 Next rngRow

End Sub

</source>
   
  

Get the last row and last cell

   <source lang="vb">

Sub LastCell()

 Dim rngLast As Range
 Dim LastRow As Long, LastCol As Long
 
 Set rngLast = Range("A1").SpecialCells(xlCellTypeLastCell)
 LastRow = rngLast.Row
 LastCol = rngLast.Column
 MsgBox LastRow & " " & LastCol

End Sub

</source>
   
  

Is in last row

   <source lang="vb">

Function LASTINROW(rngInput As Range) As Variant

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

End Function

</source>
   
  

returns a number that represents the last nonempty cell in the same row

   <source lang="vb">

Function GetLastUsedColumn(rg As Range) As Long

   Dim lMaxColumns As Long 
   lMaxColumns = ThisWorkbook.Worksheets(1).Columns.Count 
   If IsEmpty(rg.Parent.Cells(rg.Row, lMaxColumns)) Then 
       GetLastUsedColumn = _ 
           rg.Parent.Cells(rg.Row, lMaxColumns).End(xlToLeft).Column 
   Else 
       GetLastUsedColumn = rg.Parent.Cells(rg.Row, lMaxColumns).Column 
   End If 

End Function

</source>
   
  

Select active row

   <source lang="vb">

Sub SelectActiveRow()

   If IsEmpty(ActiveCell) Then Exit Sub
   On Error Resume Next
   If IsEmpty(ActiveCell.Offset(0, -1)) Then Set LeftCell = ActiveCell Else Set LeftCell = ActiveCell.End(xlToLeft)
   If IsEmpty(ActiveCell.Offset(0, 1)) Then Set RightCell = ActiveCell Else Set RightCell = ActiveCell.End(xlToRight)
   Range(LeftCell, RightCell).Select

End Sub

</source>
   
  

Select entire row

   <source lang="vb">

Sub SelectEntireRow()

   Selection.EntireRow.Select

End Sub

</source>
   
  

Select first to last row

   <source lang="vb">

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

</source>
   
  

Set the color row by row

   <source lang="vb">

Sub ColorCells3()

  Dim myRange As Range
  Dim i As Long
 
  Set myRange = Range("A1:E5")
  For i = 1 To myRange.Cells.Count
     If myRange(i).Value < 100 Then
        myRange(i).Font.ColorIndex = 6
     Else
       myRange(i).Font.ColorIndex = 1
     End If
  Next i

End Sub

</source>