VBA/Excel/Access/Word/Excel/Cells

Calling CurrentRegion to Inspect a List"s Useful Characteristics

   <source lang="vb">

Sub CurrentRegionExample()

   Dim rg As Range 
   Dim myWorksheet As Worksheet 
   Set myWorksheet = ThisWorkbook.Worksheets("Sheet1") 
   Set rg = myWorksheet.Cells(1, 1).CurrentRegion 
   myWorksheet.Range("I2").Value = rg.ListHeaderRows 
   myWorksheet.Range("I3").Value = rg.Columns.Count 
   Set rg = rg.Resize(rg.Rows.Count - rg.ListHeaderRows,rg.Columns.Count).Offset(1, 0) 
   Debug.Print rg.Rows.Count 
   Debug.Print rg.Cells.Count 
   Debug.Print Application.WorksheetFunction.CountBlank(rg) 
   Debug.Print Application.WorksheetFunction.Count(rg) 
   Debug.Print rg.Rows.Count + rg.Cells(1, 1).Row - 1 
   Set rg = Nothing 
   Set myWorksheet = Nothing 

End Sub

</source>
   
  

Cells.Find: Get Real Last Cell

   <source lang="vb">

Public Sub GetRealLastCell()

 Dim realastRow As Long
 Dim realastColumn As Long
 Range("A1").Select

 On Error Resume Next
 realastRow = Cells.Find("*", Range("A1"),xlFormulas, , xlByRows, xlPrevious).Row
 realastColumn = Cells.Find("*", Range("A1"), xlFormulas, , xlByColumns, xlPrevious).Column
 Cells(realastRow, realastColumn).Select

End Sub

</source>
   
  

Cells(Rows.Count, "A").End(xlUp).Select

   <source lang="vb">

 

Sub EndUp()

 Cells(Rows.Count, "A").End(xlUp).Select

End Sub

</source>
   
  

Entering a value in the next empty cell

   <source lang="vb">

Sub GetData()

 Do
   NextRow = Application.WorksheetFunction.CountA(Range("A:A")) + 1
   Entry1 = "A"
   Entry2 = "B"
   Cells(NextRow, 1) = Entry1
   Cells(NextRow, 2) = Entry2
 Loop

End Sub

</source>
   
  

Get cell value

   <source lang="vb">

Sub cellValue()

   Dim num1 As Integer
   Dim num2 As Integer
   
   num1 = Cells(1, 1).Value
   num2 = Cells(1, 2).Value
   Dim result As Boolean
   
   result = (num1 <= 10) And (num2 <> 50)
   Debug.Print result

End Sub

</source>
   
  

looping through a worksheet range using a For/Next loop.

   <source lang="vb">

Sub NestedFor()

   Dim I As Integer
   Dim J As Integer
   
   For I = 1 To 10
       For J = 4 To 7
           Cells(I, Chr(J + 64)).Value = I * J
       Next J
   Next I

End Sub

</source>
   
  

Set cell value with For Loop

   <source lang="vb">

Sub RangeObjects()

  Dim i As Integer, j As Integer
  For i = 1 To 10
     For j = 1 To 5
        Cells(i, j).Value = i * j
     Next j
  Next i

End Sub

</source>
   
  

Sum Cells Based on the Interior Color

   <source lang="vb">

Function SumByColor(CellColor As Range, SumRange As Range)

   Dim myCell As Range
   Dim iCol As Integer
   Dim myTotal
   iCol = CellColor.Interior.ColorIndex 
   For Each myCell In SumRange 
       If myCell.Interior.ColorIndex = iCol Then
           myTotal = WorksheetFunction.Sum(myCell) + myTotal
       End If
   Next myCell
   SumByColor = myTotal

End Function

</source>
   
  

Use row and column index to reference cell

   <source lang="vb">

Sub ReferAcrossWorksheets3()

 Range(Sheets("Sheet1").Cells(1, 1), Sheets("Sheet1").Cells(10, 5)).Font.Bold = True

End Sub

</source>
   
  

Use the AutoFill function by specifying the destination range

   <source lang="vb">

Sub autoFillRange()

   Cells(2, "B").autoFill Destination:=Range("B2:B10")

End Sub

</source>
   
  

Using Replace Programmatically to Set the Correct Range

   <source lang="vb">

Sub ReplaceExample()

   Dim ws As Worksheet 
   Dim rg As Range 
   Dim lLastRow As Long 
   Set ws = ThisWorkbook.Worksheets("Replace Examples") 
   lLastRow = ws.Cells(65536, 1).End(xlUp).Row 
   Set rg = ws.Range(ws.Cells(2, 2), ws.Cells(lLastRow, 3)) 
   rg.Replace "", "UNKNOWN" 
   Set rg = ws.Range(ws.Cells(2, 4), ws.Cells(lLastRow, 4)) 
   rg.Replace "", "0" 
   Set rg = Nothing 
   Set ws = Nothing 

End Sub

</source>