I am new to VBA Macro. i just want to know how to get the last row that has value within a range
Set MyRange = Worksheets(strSheet).Range(strColumn & "1")
GetLastRow = Cells(Rows.Count, MyRange.Column).End(xlUp).Row
this code could find the last row for the whole sheet.. i just want it to find the last non null value cells
(
like in this case in the picture.. for the ("A8") range, the last row result should be ("A9:B9")
"A9:B9" cannot be last row... It is a range.
If you need such a range, but based on the last empty row, starting from a specific cell, you can use the next approach:
Sub testLastRowRange()
Dim sh As Worksheet, myRange As Range, lastRow As Long, strColumn As String
Dim lastCol As Long, endingRowRng As Range, strSheet As String
strSheet = ActiveSheet.Name 'please, use here your real sheet name
Set sh = Worksheets(strSheet)
strColumn = "A"
Set myRange = sh.Range(strColumn & 8)
lastRow = myRange.End(xlDown).row
lastCol = myRange.End(xlToRight).Column
Set endingRowRng = sh.Range(sh.Cells(lastRow, myRange.Column), sh.Cells(lastRow, lastCol))
Debug.Print endingRowRng.address
End Sub
For your specific example you could use CurrentRegion property.
This is based on the ActiveCell which is not generally advisable.
Sub x()
Dim r As Range
Set r = ActiveCell.CurrentRegion
MsgBox r.Address
End Sub
Related
How do I get the position of the last non-empty cell in a filtered column without dropping the applied Autofilter? I understand it's easy to get the number of the last visible row with
Dim ws as Worksheet, rng As Range
Set rng = Range(Letter & 1 & ":" & Letter & 1) ' where Letter is the letter code of the column
GetLastVisibleRow = ws.Range(Split(ws.Cells(, rng.Column).Address, "$")(1) & ws.Rows.count).End(xlUp).row
but I need the number of the last filled row instead. At the same time, I'd like to avoid setting
ws.AutoFilterMode = False
if it's possible.
Thanks in advance.
Probably not the most efficient or fastest method, but this appears to work:
Function GetLastCellOfColumn(ColLetter As String) As Range
Dim Col As Range
Dim Rw As Long
Set Col = Range(ColLetter & ":" & ColLetter)
Set GetLastCellOfColumn = Intersect(ActiveSheet.UsedRange, Col)
For Rw = GetLastCellOfColumn.Cells.Count To 1 Step -1
If Len(GetLastCellOfColumn.Cells(Rw).Value) > 0 Then
Set GetLastCellOfColumn = GetLastCellOfColumn.Cells(Rw)
Exit Function
End If
Next
End Function
A charming solution by #jkpieterse plus a useful comment by #BigBen is exactly what I was looking for. Just to finalize the thread, the function returning the row number is
Function GetLastFilledCellOfColumn(ws As Worksheet, ColLetter As String) As Long
Dim Col As Range, Urng As Range, Rw As Long
Set Col = ws.Range(ColLetter & ":" & ColLetter)
Set Urng = Intersect(ws.UsedRange, Col)
For Rw = Urng.Cells.count To 1 Step -1
If Not IsEmpty(Urng.Cells(Rw)) Then
GetLastFilledCellOfColumn = Rw
Exit Function
End If
Next
End Function
Problem solved.
So maybe this is an alternative way to look into:
Sub Test()
Dim rng As Range
Dim col As Long: col = 2 'Change to whichever column you interested in
Dim rw as Long
With Sheet1 'Change to whichever sheets CodeName you need
Set rng = .Range("_FilterDatabase").Columns(col)
rw = .Evaluate("MAX(IF(" & rng.Address & "<>"""",ROW(" & rng.Address & ")))")
End With
End Sub
I'm afraid I rushed this a little and might have made a mistake but will have to get going. Hopefully you understand whats going on =)
Edit:
The above would definately work, but as figured out through the chat, there is actually a ListObject involved, called Table1, which throws of the AutoFilter range. So here are two alternative ways of doing the same thing:
Sub Test()
Dim rng As Range
Dim col As Long: col = 2 'Change to whichever column you interested in
Dim rw as Long
With Sheet1 'Change to whichever sheets CodeName you need
Set rng = .Range("Table1")
rw = .Evaluate("MAX(IF(" & rng.Address & "<>"""",ROW(" & rng.Address & ")))")
End With
End Sub
Or, when you don't know the name of the table:
Sub Test()
Dim rng As Range
Dim col As Long: col = 2 'Change to whichever column you interested in
Dim rw as Long
With Sheet1 'Change to whichever sheets CodeName you need
Set rng = .ListObjects(1).Range
rw = .Evaluate("MAX(IF(" & rng.Address & "<>"""",ROW(" & rng.Address & ")))")
End With
End Sub
I want to get a list of distinct value based on a criteria, example : I have a list of stores, and i want to get only distinct value based on retailer criteria "BOULANGER".
Sub distinctValues()
Dim LastRow As Long
Dim Crit1 As String
LastRow = Sheets("SOURCE").Cells(Rows.Count, "B").End(xlUp).Row
Sheets("SOURCE").Range("B1:B" & LastRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets("TEST").Range("E2"), CopyToRange:=Sheets("TEST").Range("A12"), Unique:=True
End Sub
I suspect your Criteria Range is not properly set up and/or named on your worksheet.
In the .AdvancedFilter, you have:
Range(Crit1)
which, according to your code, will be interpreted as:
Range("BOULANGER")
This presumes you have a Named Range somewhere on your Test Worksheet that is named BOULANGER and refers to two cells in a column, the first of which contains Store and the second contains BOULANGER
If you have that set up properly, then your code works.
Note that in your screen shot showing the criteria, the first cell contains Criteria and not Store. So even if you had the defined range setup to encompass those two cells, it would not work since the first row has to have an identical name to the column being filtered.
This should accomplish what you are trying to do; see comments in the code.
Sub ListUniqueValues()
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = ThisWorkbook.Sheets("Sheet1") 'change as needed
Set ws2 = ThisWorkbook.Sheets("Sheet2") 'change as needed
ws1.Range("B1", ws1.Cells(Rows.Count, "B").End(xlUp)).Copy ws2.Range("C1") 'copy the full range from sheet1
ws2.Range("C1", ws2.Cells(Rows.Count, "C").End(xlUp)).RemoveDuplicates Columns:=Array(1), Header:=xlNo 'remove duplicates
Dim lRow As Long
lRow = ws2.Cells(Rows.Count, 3).End(xlUp).Row 'set lastrow variable
For i = lRow To 1 Step -1 'Da Loop, from bottom to top
'change the cell address after "Like" to the cell address where you put your store criteria
'the line will delete any store name that is not like your store criteria
'the (& "*") inserts the wildcard after your store criteria you type in your designated cell, e.g. "BOULANGER*"
If Not ws2.Cells(i, 3).Value Like ws2.Cells(1, 1).Value & "*" Then '
ws2.Cells(i, 3).Delete 'delete the cells that do not match your store criteria
End If
Next i
End Sub
If you are trying to get a unique range that contains a keyword, something like this should work.
Option Explicit
Private Sub OutputUniqueRange(SearchRange As Range, Keyword As String, OutputRange As Range)
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
Dim cell As Range
For Each cell In SearchRange
With cell
If InStr(1, .Value2, Keyword, vbTextCompare) > 0 And Not dict.exists(.Value2) Then dict.Add .Value2, .Value2
End With
Next
If dict.Count = 0 Then Exit Sub
OutputRange.Range(OutputRange.Cells(1, 1).Address).Resize(dict.Count, 1) = Application.Transpose(dict.items())
End Sub
Public Sub TestSub()
Dim SearchRange As Range
Dim Keyword As String
Dim OutputRange As Range
Keyword = "Boulanger"
Set SearchRange = ThisWorkbook.Sheets("Sheet1").Range("A2:A34")
Set OutputRange = ThisWorkbook.Sheets("Sheet1").Range("B2")
OutputUniqueRange SearchRange, Keyword, OutputRange
End Sub
So I am learning VBA, I know how to program on Matlab and some C++. I am wondering how I can use the CountA to count all of the cells used on a specific row and only that row. ( I have multiple examples on ranges and columns but none on a Row only).I cannot use a range because I want to use this VBA in the future and this row will have a number of variables changing. I would also like to have the content(text) of those cells moved to another location with no spaces between them because right now they have three spaces between each used cell.
So far I have this code which isn't very much for the countA of the first row
Sub CountNonBlankCells()
Dim numcompanies As Integer
n = Sheet1.CountA(Rows(1))
Worksheets("start on this page").Range("B2") = n
End Sub
I have nothing for the part where I take that data from each cell to another location.
Sure you can use a Range. Your question is pretty broad, but for tutorial purpose ... here's a piece of code that counts the number of nonblank cells in a number of rows and shows you what's in each of them ...
Sub TestCount()
Dim mySht As Worksheet
Dim myRng As Range, oRow As Range
Dim lstRow As Long, lstCol As Long
Dim nUsed As Long
Dim iLoop As Long
Set mySht = Worksheets("Sheet13")
lstRow = mySht.Range("A1").End(xlDown).Row
lstCol = mySht.Range("A1").End(xlToRight).Column
Set myRng = mySht.Range(Cells(1, 1), Cells(lstRow, lstCol))
Debug.Print "Number of Rows is " & myRng.Rows.Count
For Each oRow In myRng.Rows
nUsed = Application.CountA(oRow)
For iLoop = 1 To nUsed
Debug.Print oRow.Cells(1, iLoop)
' assign oRow.Cells(1,iLoop) to something else here
Next iLoop
Next oRow
End Sub
As per your question I am assuming that you want to copy a complete row having blank cells to another location(row) but without blank cells.
I guess this is what you want.
Sub CountNonBlankCells()
Dim CurrentSh As Worksheet, TargetSh As Worksheet
Dim LastColumn As Long, count As Long
Dim MyRange As Range
Dim i As Long, temp As Long
Dim RowNum As Long
Set CurrentSh = ThisWorkbook.Worksheets("Sheet1")
Set TargetSh = ThisWorkbook.Worksheets("Sheet2")
RowNum = ActiveCell.Row
LastColumn = CurrentSh.Cells(RowNum, Columns.count).End(xlToLeft).Column
Set MyRange = CurrentSh.Rows(RowNum)
count = WorksheetFunction.CountA(MyRange)
temp = 1
For i = 1 To LastColumn
If Not IsEmpty(CurrentSh.Cells(RowNum, i)) Then
TargetSh.Cells(RowNum, temp).Value = CurrentSh.Cells(RowNum, i).Value
temp = temp + 1
End If
Next i
End Sub
Above code will copy active row in Sheet1 to Sheet2 at same row number without blank cells.
Newbie question: I have module, originally made by Roger Govier.
It uses an input cell header and creates a dynamic named range for the non empty cells positioned under header. The created named range will be labeled as the value of the header cell.
Private Sub CreateNamedRange(header As range)
Dim wb As Workbook
Dim WS As Worksheet
Dim rStartCell As range
Dim rData As range
Dim rCol As range
Dim lCol As Long
Dim sSheet As String
Dim Rowno As Long
' get table location
Set rStartCell = header
Set WS = rStartCell.Worksheet
Set wb = WS.Parent
sSheet = "'" & WS.Name & "'"
With rStartCell
Rowno = .row
Set rData = .CurrentRegion
End With
Set rData = WS.range(rStartCell, WS.Cells(Rowno, rStartCell.Column))
Set rCol = rData.Columns
lCol = rCol.Column
wb.Names.Add Name:=Replace(rCol.Cells(1).Value, " ", "_"), _
RefersToR1C1:="=" & sSheet & "!" & rCol.Cells(2).Address(ReferenceStyle:=xlR1C1) & ":INDEX(C" & lCol & ",LOOKUP(2,1/(C" & lCol & "<>""""),ROW(C" & lCol & ")))"
End Sub
I want to modify this code so that instead of creating a named range it only returns the returns the range of the what would have been the named range.
Example:
We have a header in A1, and data in A2:A5.
Now: If we call CreateNamedRange(.range("A1")), it creates a dynamic named range for A2:A5.
Goal: If we call CreateNamedRange(.range("A1")) it returns .range("A2:A5") to a variable in the VBA code:
dim myRange As Range
set myRange = CreateNamedRange(.range("A1"))
First thing you should note is that Subs do not return any value and thus myRange = CreateNamedRange(.range("A1")) does not make any sense (with your Sub; it does make sense with the Function in this answer).
The function below returns a range, in the same column that the input range, starting from the next row and including all the ones below until finding a blank cell. This range is called "anyName" (and thus you can access it via Range("anyName")).
Private Function CreateNamedRange(header As Range) As Range
Dim curRow As Long: curRow = header.Row + 1
Set tempRange = header.Worksheet.Cells(curRow, header.Column)
Do While (Not IsEmpty(tempRange))
curRow = curRow + 1
Set tempRange = header.Worksheet.Cells(curRow, header.Column)
Loop
Set CreateNamedRange = header.Worksheet.Range(header.Worksheet.Cells(header.Row + 1, header.Column), header.Worksheet.Cells(curRow, header.Column))
CreateNamedRange.Name = "anyName"
End Function
If you already have the beginning cell activated you can just use
Set myRange = Range(ActiveCell.Address, ActiveCell.Offset.End(xlDown).Address)
to set your range for all entries below the active cell. If you don't have it activated, you can just use your rstartCell reference with an offset
Set myRange = Range(rStartCell.Offset(1), rStartCell.Offset(1).Offset.End(xlDown).Address)
Then you can just add the named range in the next line
How to get the starting and ending rownum when using excel Autofilter function in VBA.
I have a set of 500k+ records. and use filters on a particular column. Due to this because of filters the starting rownum might change since other records are hidden in autofilter
so on using the autofilter i might end with startrow as 74562 and ending 87000.
Can someone show a macro which could output the startrow and endrow for every filter I use.
The data is sorted so any filter would be a fixed consecutive bunch
EDIT:
I have realized that the following code gives the result but in range
MsgBox ActiveSheet.Range("A2:A81000").Rows.SpecialCells(xlCellTypeVisible).Address
It shows result as $A$73351:$A$77343. But I just want the 73351 in StartRow variable and 77343 in EndRow variable. How to do that?
You ask how to return the row number of the first and last row in a range. This is how:
Dim r As Range
Dim StartRow As Long
Dim EndRow As Long
Set r = ActiveSheet.Range("A2:A81000").Rows.SpecialCells(xlCellTypeVisible)
' r is now $A$73351:$A$77343
StartRow = r.Row ' returns 73351
EndRow = r.Row + r.Rows.Count - 1 ' returns 77343
dim rRange as Range
Set rRange = Range("A1")
Debug.Print rRange.Offset(1, 0).Row
Debug.Print rRange.Offset(ActiveSheet.Rows.Count - 1, 0).End(xlUp).Row
You can try this piece of code:
Sub Get_Filtered_Range()
Dim oWS As Worksheet
Dim oRng As Range
Dim oColRng As Range
Dim oInRng As Range
oWS = ActiveSheet
'Trigger any autofilter if needed
'oWS.UsedRange.AutoFilter(Field:=2, Criteria1:="Test")
oRng = oWS.Cells.SpecialCells(xlCellTypeVisible)
oColRng = oWS.Range("A2:A"&ActiveSheet.Rows.Count)
oInRng = Intersect(oRng, oColRng)
'display the values in the VBEditor
Debug.Print("Filtered Range is " & oInRng.Address)
Debug.Print("First Row Filtered Range is " & oInRng.Rows(1).Row)
End Sub
Adapted from here