Collect Last Rows
- The first code is a quick fix of your issues. It is still not recommended.
- The second code shows the advantages of using constants, of fully qualifying worksheets and ranges and of commenting your code (Be aware that this code is over-commented, you usually only comment sections of it.).
Tips
- This post explains why we mostly do not use
Integer any more.
- Try avoiding
Active in any flavor i.e. ActiveWorkbook, ActiveSheet, ActiveCell.
- Use variables. Use meaningful names (poorly demonstrated). Additionally maybe make up names for them.
- Be careful when declaring variables in one line:
Dim x As..., y As..., z As....
- In the second code, if declaring variables as they are needed is too confusing at this stage, copy all those
Dims to the beginning of the code right after the constants to make it more readable for you.
The Code
Option Explicit
Sub LastRowsQF()
Dim row As Long
Dim i As Integer
Dim j As Integer
Dim a As String
Dim b As Range
Dim myrange As Range
Dim count As Integer
Dim url As String
Dim lastRow As Long, lRow As Long
' Not:
'Dim lastRow, lRow As Long ' Wrong!
Dim iCntr As Integer, jCntr As Integer, iMaxRow As Integer
' Not:
'Dim iCntr, jCntr, iMaxRow As Integer ' Wrong!
Dim vMax
' This means 18 rows by 1 column.
Dim arr2(1 To 18, 1 To 1)
' Not:
' This means 1 row with 19 columns (elements)!
'Dim arr2(18)
For iCntr = 1 To 18 ' for each column
'vMax = 0 ' Not used.
'iMaxRow = 2 ' Not used.
'Finding last Row of current Column
With ActiveSheet
lastRow = .Cells(.Rows.count, iCntr).End(xlUp).row
End With
arr2(iCntr, 1) = lastRow
Next
Worksheets("Sheet1").Range("B2:B19").Value = arr2
End Sub
Sub LastRows()
' Constants
Const srcNumberOfColumns As Long = 18 ' Source Number of Columns
Const tgtName As String = "Sheet1" ' Target Worksheet Name
Const tgtFirstCell As String = "B2" ' Target First Cell Range Address
' Define workbook ('wb').
Dim wb As Workbook
Set wb = ThisWorkbook ' The workbook containig this code.
' Define Source Worksheet ('ws').
Dim ws As Worksheet
Set ws = wb.ActiveSheet ' e.g. wb.worksheets("Sheet2") is preferred.
' Define (2D one-based one-column) Data Array ('Data').
Dim Data As Variant
ReDim Data(1 To srcNumberOfColumns, 1 To 1)
' Write last row of each column to rows of Data Array.
Dim j As Long
For j = 1 To srcNumberOfColumns
Data(j, 1) = ws.Cells(ws.Rows.count, j).End(xlUp).row
Next
' Define Target Worksheet ('ws').
' Note: Use a different variable if you still need to use Source Worksheet.
Set ws = wb.Worksheets(tgtName)
' Define Target Range ('rng').
Dim rng As Range
Set rng = ws.Range(tgtFirstCell).Resize(UBound(Data, 1))
' Write values from Data Array to Target Range.
rng.Value = Data
End Sub