I haven't been able to find an answer to what a single number represents here. I'm trying to find the row where the last occurrence of a string occurs, copy that entire row, and insert it below that row. To try and get the first part, where I can find the row value of the last occurrence, what does this "3" represent?
Dim shortname As String
Dim endRow As Integer
Dim lastRowSearchValue As Range
shortname = "CATS"
With ActiveSheet
endRow = .Cells(Rows.Count, 33).End(xlUp).Row
For i = 1 To endRow
If .Cells(i, 33) = shortname Then
lastRowSearchValue = i
End If
Next i
End With
lastRowSearchValue.Copy
Cells(Row,Column)
So it is the Column number.
See: https://learn.microsoft.com/en-us/office/vba/api/excel.worksheet.cells
So .Cells(Rows.Count, 33).End(xlUp).Row is starting at the bottom of Column 33 and and searching up till it finds the first cell from the bottom that has a value.
Then the loop is looping from the first Row to that last row and checking the value in that column on each row.
If .Cells(i, 33) = shortname Then is then checking that cell, each one in that column if its value is the same as shortname
but this is probably an x/y problem as lastRowSearchValue = i does not return a range but a long:
You want:
Set lastRowSearchValue = .Cells(i,33)
I assume you need cell rather row number. Anyway, the following code tries to find this cell:
Sub FFF()
Dim cell As Range, lastRowSearchValue&
Set cell = Columns(33).Find(What:="CATS", LookAt:=xlWhole, SearchDirection:=xlPrevious)
If Not cell Is Nothing Then
lastRowSearchValue = cell.Row
Else
MsgBox "No value found", vbExclamation
End If
End Sub
Correcting Code
endRow has to be declared as long because .Rows.Count exceeds the limit for Integer.
33 is the column number, or Column AG. Your code searches for CATS in column AG starting from row 1 to the last row with data and when found it assigns the found row number to lastRowSearchValue which is incorrect because lastRowSearchValue is a range. Correct would be Set lastRowSearchValue = .Cells(i, 33) to be able to continue with lastRowSearchValue.Copy. It will continue searching until the end to find other occurrences of CATS. To stop this you can add the line Exit For to exit the loop when CATS was found. But since you do want to find the last occurrence, you don't wanna do that.
I've chosen to declare lastRow as Long to get the last occurring row and then copy that row one row below. To make it less confusing, I have used the column letters.
The Code
Sub CopyRowBelowWhenFound()
Dim shortname As String
Dim endRow As Long
Dim lastRow As Long
Dim i As Integer
shortname = "CATS"
With ActiveSheet
endRow = .Cells(.Rows.Count, "AG").End(xlUp).Row
For i = 1 To endRow
If .Cells(i, "AG") = shortname Then
lastRow = i
End If
Next i
With .Cells(lastRow, "AG")
.EntireRow.Copy .Offset(1, 0).EntireRow
End With
End With
End Sub
Related
I'm sure this is possible, im just not sure what the code should be. i have 2 sheets: (1)Component which has all the Component Names where an analyst got marked down on, including dates of when the call occurred, and (2)Calculator, which counts the number of times a specific component appeared in a specific week number.
ive created a code which gets the distinct Component Names from the Component Sheet, and then copies and transpose them to the Calculator sheet. all the Component Names are in Row 1 starting from Column D1 then goes to E1, F1, and so on. i want row 2 to display the count or the number of times the component(listed in row 1) appeared in a week.
The code i have only works for columns, i do not know how to make it get the non-empty values of an entire row.
'//here the code i used to transpose Distinct Components from the Component sheet to the Calculator Sheet
Public Sub GetDistinctComponents()
Application.ScreenUpdating = False
Dim lr As Long
lr = Sheets("Components Data").Cells(Rows.Count, "F").End(xlUp).Row
Sheets("Calculator").Unprotect Password:="secret"
Sheets("Components Data").Range("F1:F" & lr).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=ActiveSheet.Range("DW1"), Unique:=True
With ThisWorkbook.Worksheets("Calculator")
.Range(.Range("DW1"), .Range("DW1").End(xlDown)).Copy
.Range("DX1").PasteSpecial xlPasteValues, Transpose:=True
.Columns("DW").EntireColumn.Delete
End With
Sheets("Calculator").Protect Password:="secret", DrawingObjects:=False
End Sub
Here's my Component sheet
And below is my Calculator sheet. as you can see, the code to transpose the distinct Components works fine. i just do not know how to get the value of Row 1 starting from DX so i can store it in a variable which i will use in counting the number of times that component appeared in a week . I'm thinking it should go like this
Component = wsCalculator.Cells(i, "D").Value
But this code only works if i want to get the Values of all cells in Column D, not the values of the cells next to D1
and here's the code i currently have
Public Sub CountComponent()
Application.ScreenUpdating = False
Sheets("Calculator").Unprotect Password:="secret"
Set wsComponentData = Sheets("Components Data")
Set wsCalculator = Sheets("Calculator")
Dim ComponentCount As Integer
'//Get the index of the last filled row based on column A
LastComponentRowIndex = wsComponentData.Cells(Rows.Count, "A").End(xlUp).Row
'//Get Range for ComponentData
Set ComponentRange = wsComponentData.Range("F2:F" & LastComponentRowIndex)
'//Get the index of the last filled row based on column C
LasttotalauditRowIndex = wsCalculator.Cells(Rows.Count, "C").End(xlUp).Row
'//Get range for Calculator
Set MyRange = wsCalculator.Range("C2:C" & LasttotalauditRowIndex)
TotalCalls = WorksheetFunction.Sum(MyRange)
'//Looping through all filled rows in the Components Data sheet
For i = 2 To wsCalculator.Cells(Rows.Count, "A").End(xlUp).Row
'//Get Component from cell in column "DW"
'Component = wsCalculator.Cells(i, "DW").Value
'//Count the # of calls that got hit in the corresponding Component
If wsCalculator.Cells(i, "DW").Value <> "" Then
ComponentCount = Application.WorksheetFunction.CountIf( _
ComponentRange, component)
wsCalculator.Cells(i, "DX").Value = ComponentCount
End If
Next
End Sub
I'll take a crack at this. I'm not 100% sure what you are doing, but I'm going to assume you will have soon calculations in cells D2, down, and to the right. Is that correct? Try this small code sample to copy from D2 (down and right) on the "Components Data" sheet, and transpose to your "Calculator" sheet.
Sub TransposeThis()
Set Rng = Sheets("Components Data").Range("D2:D7") 'Input range of all fruits
Set Rng_output = Sheets("Calculator").Range("B2") 'Output range
For i = 1 To Rng.Cells.Count
Set rng_values = Range(Rng.Cells(i).Offset(0, 1), Rng.Cells(i).End(xlToRight)) 'For each fruit taking the values to the right which need to be transposed
If rng_values.Cells.Count < 16000 Then 'To ensure that it doesnt select till the right end of the sheet
For j = 1 To rng_values.Cells.Count
Rng_output.Value = Rng.Cells(i).Value
Rng_output.Offset(0, 1).Value = rng_values.Cells(j).Value
Set Rng_output = Rng_output.Offset(1, 0) 'Shifting the output row so that next value can be printed
Next j
End If
Next i
End Sub
Before:
After:
If I got something wrong, post your feedback, and I'll adjust the code to suit your needs.
The code below is your own code, in part, which I commented, and of my own making for those parts where you seemed to have lost your way.
Public Sub CountComponent()
' Locations:-
Dim WsComp As Worksheet
Dim WsCalc As Worksheet
Dim CompRng As Range ' column A
Dim CalcRng As Range ' Calculator!D1:D?)
Dim Rt As Long ' Target row (in WsCalc)
' Helpers:-
Dim Cell As Range
Dim R As Long
Set WsComp = Sheets("Components Data")
Set WsCalc = Sheets("Calculator")
WsCalc.Unprotect Password:="secret"
Application.ScreenUpdating = False
'//Get the index of the last filled row based on column A
With WsComp
' observe the leading period in ".Rows.Count"
'LastComponentRowIndex = .Cells(.Rows.Count, "A").End(xlUp).Row
'//Get Range for ComponentData
'Set CompRng = .Range("A2:A" & LastComponentRowIndex)
' avoids the need for decalring LastComponentRowIndex
Set CompRng = .Range(.Cells(2, "A"), _
.Cells(.Rows.Count, "A").End(xlUp))
End With
With WsCalc
' set a range of all criteria to look up
Set CalcRng = .Range(.Cells(1, "D"), _
.Cells(1, .Columns.Count).End(xlToLeft))
'//Get the index of the last non-empty row in column B
' loop through all rows in WsCalc
For R = .Cells(.Rows.Count, "B").End(xlUp).Row To 2 Step -1
If Val(.Cells(R, "B").Value) Then ' presumed to be a week number
'//Loop through all audit criteria
For Each Cell In CalcRng
With .Cells(R, Cell.Column)
.Value = WorksheetFunction.CountIfs( _
CompRng, Cell.Value, _
CompRng.Offset(0, 1), WsCalc.Cells(R, "B").Value)
.NumberFormat = "0;-0;;" ' suppress display of zero
End With
Next Cell
End If
.Cells(R, "C").Value = WorksheetFunction.Sum(CalcRng.Offset(R - 1))
Next R
End With
Application.ScreenUpdating = True
End Sub
Frankly, I couldn't understand all of your intentions. I presumed that column B in your Calculations sheet would contain a week number and that this week number would also be found in the Components Data (in column B). If so, you would be counting the occurrences of each component by week, and that is what I programmed.
I think it doesn't matter if I got that part wrong. Your main question was how to look up each of the Components in Calculations!D1:??. That method is very well demonstrated in my above answer and I feel confident you will be able to transplant the useful bits to your own project. Good luck!
I suggest taking a look at VBA dictionaries. In this case, you could store each component as a key and for the value you can accumulate the number of occurrences of the component for a given week.
I don't have a VBA editor available on my computer at the moment to test this, but it would likely look something along the lines of what I've got below. Also, I'll admit that I may not have fully understood the layout of your sheets, but the general principle here will definitely apply.
For a pretty full overview of dictionaries in VBA, here's a good resource that'd I'd recommend: https://excelmacromastery.com/vba-dictionary/
Public Sub CountComponent()
Application.ScreenUpdating = False
Sheets("Calculator").Unprotect Password:="secret"
Set wsComponentData = Sheets("Components Data")
Set wsCalculator = Sheets("Calculator")
'//Get the index of the last filled row based on column A
LastComponentRowIndex = wsComponentData.Cells(Rows.Count, "A").End(xlUp).Row
'//Get Range for ComponentData
Set ComponentRange = wsComponentData.Range("A2:A" & LastComponentRowIndex)
'//Get the index of the last filled row based on column C
LasttotalauditRowIndex = wsCalculator.Cells(Rows.Count, "C").End(xlUp).Row
'//Get range for Calculator
Set MyRange = wsCalculator.Range("C2:C" & LasttotalauditRowIndex)
TotalCalls = WorksheetFunction.Sum(MyRange)
'// Declare a new dictionary
dim componentDict as New Scripting.Dictionary
'// First loop through the Calculator sheet to get each component
'// and set initial value to zero
dim i as Long, lastCalcColumn as Long
lastCalcColumn = wsCalculator.Cells(1, Columns.count).end(xlToLeft).Column
for i = 4 to lastCalcColumn
'// Adding each item to dictionary, a couple of ways to write this,
'// but this is probably the easiest
componentDict(wsCalculator.Cells(i, 1).Value) = 0
next i
'//Looping through all filled rows in the Components Data sheet
'// I changed this to loop through each row in your component sheet
'// So that we can accumulate the total occurences
dim current_key as String
For i = 2 To LastComponentRowIndex
If wsComponentData.Range("G" & i).Value <> "" Then
'// assuming component names are in the "G" column
'// change this as needed
current_key = wsComponentData.Range("G" & i).Value
componentDict(current_key) = componentDict(current_key) + 1
end if
Next i
'// now back to the Calculator sheet to enter the values
for i = 4 to lastCalcColumn
current_key = wsCalculator.Cells(i, 1).Value
wsCalculator.Cells(i, 2).Value = componentDict(current_key)
next i
End Sub
My input form contains 2 texts which corresponds to a specific row & column header of my worksheet. I want to use the 2 selected texts in the form to locate the cell, and edit the respective cell's value.
1 of the value is part of an array in a Listbox (e.g. located in ListBox2.Column(0,1))
The other value is from a combo box (e.g. cmbName).
How can I use these 2 values to locate the cell? I thought maybe index/match will work, but it seems all too complicated.. any help will be appreciated - thanks!
I tried doing a double for loop to locate the column, but I can't figured out how to locate the right row.
For m=27 To finalcol
For n = 0 to ListBox2.ListCount - 1
If ListBox2.Column(0,n) = Trim(ThisWorkBook.Worksheets("Masterlist").Cells(1,m).Text) Then
MsgBox ("Matched!")
End If
Next n
Next m
I get the "Matched!" output, but I'm not sure how to achieve the next step. Is this approach fundamentally limited?
First you can find the row corresponding to cmbName, and then the column as you already did:
' Find the row corresponding to cmbName
For r=2 To ThisWorkBook.Worksheets("Masterlist").UsedRange.Rows.Count
If cmbName = Trim(ThisWorkBook.Worksheets("Masterlist").Cells(r,1).Text)
therow=r
End if
Next r
' Find the column corresponding to ListBox2 column 0:
For m=27 To finalcol
For n = 0 to ListBox2.ListCount - 1
If ListBox2.Column(0,n) = Trim(ThisWorkBook.Worksheets("Masterlist").Cells(1,m).Text) Then
If ListBox2.Selected(n)
ThisWorkBook.Worksheets("Masterlist").Cells(therow,m).Text = ListBox2.Column(1,n)
End If
End If
Next n
Next m
If you want to use the double for loop it would be something like:
Public Sub Test
'Loops through all items in Listbox2'
For n = 0 to ListBox2.ListCount - 1
FindCell ListBox2.List(n)
Next
End Sub
Private Sub FindCell (lstValue As String)
'Sets the ws As a variable we can use'
Dim ws as Worksheet
Set ws = ThisWorkBook.Worksheets("Masterlist")
Dim ColumnLetter as String
'Find the last non-blank cell in row 1
lCol = Cells(1, Columns.Count).End(xlToLeft).Column
'Loops through each cell in Row 1'
For Each cell In ws.Range("A1:A" & lCol)
If cell.Value = lstValue Then 'Checks if the cell value is equal to the item we passed in from the ListBox'
ColumnLetter = Split(Cells(1, cell.Column).Address, "$")(1) 'To use Worksheet.Range below, we need to find the column letter'
'Find the last non-blank cell in column A(1)
lRow = Cells(Rows.Count, cell.Column).End(xlUp).Row 'Goes from the bottom of the file up to the first cell that contains a value and stores the row # as a variable'
For Each cellCol in ws.Range(ColumnLetter & "2:" ColumnLetter & lRow) 'Now we need to check each cell in the row for the value in the combo box'
If cellCol.Value = cmbName.Value Then
Messagebox ("Matched")
End If
Next
End If
Next
End Sub
Let me know how this goes :)
You can try this.
I dummied up a worksheet that looks like this ...
... I then added a named range to that matrix called rngDataSet.
Then, using this code, it demonstrates logic that will ultimately find and select the relevant cell based on the row and column headings you provide. You should be able to adapt this code to your own logic.
Public Sub FindCell(ByVal rngDataSet As Range, ByVal strRowHeader As String, ByVal strColHeader As String, ByVal varNewValue As Variant)
Dim objCell As Range, objColCell As Range, objRowCell As Range
' Find the column header
For Each objCell In rngDataSet.Rows(1).Cells
If UCase(Trim(objCell.Text)) = UCase(Trim(strColHeader)) Then
Set objColCell = objCell
Exit For
End If
Next
' Find the row header
For Each objCell In rngDataSet.Columns(1).Cells
If UCase(Trim(objCell.Text)) = UCase(Trim(strRowHeader)) Then
Set objRowCell = objCell
Exit For
End If
Next
If objColCell Is Nothing Or objRowCell Is Nothing Then
MsgBox "Either 1 or both of the supplied headers were not found.", vbCritical, "Error"
Else
rngDataSet.Worksheet.Cells(objRowCell.Row, objColCell.Column) = varNewValue
End If
End Sub
Public Sub DoFindCell()
Dim strRowHeader As String, strColHeader As String
strRowHeader = InputBox("Row Header ...", "Row Header", "Row Header ")
strColHeader = InputBox("Column Header ...", "Column Header", "Col Header ")
FindCell Sheet1.Range("rngDataSet"), strRowHeader, strColHeader, “New Value”
End Sub
I hope that helps.
"DoFindCell" only exists to invoke the logic, that should be replaced by your own list/combo box values.
I'm looping over values in Column B of the current worksheet. If the value's length is 8 characters, copy the WHOLE row to another sheet.
It is kind of working, but I'm missing around a hundred rows that should have been copied.
I guess it's to do with the format of the cell values in Column B. There are some that are just Text headers which will definitely not meet the criteria. The ones that it should copy are all in this format (Column B):
6008571X
60088242
....
The rows I'm interested in have 8 characters in Column B. The problem is that some of them might be formatted as numbers some as text (or perhaps preceded by ').
Sub aims()
Dim i As Long
'Get the address of the first non blank cell in Row B from the bottom
MyFirstBlankAddress = Range("B1048576").End(xlUp).Offset(1, 0).Address
'Extract the number from the address to get the row number
MyRowNumber = Split(MyFirstBlankAddress, "$")(2)
For i = 1 To MyRowNumber
With Range("B" & i)
If Len(.Value) = 8 Then .EntireRow.Copy Destination:=Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
End With
Next i
End Sub
I was expecting 410 rows copied, while only 276 got copied.
EDIT: I have been reading your answers/suggestions and testing stuff. I've found out that the problem lies elsewhere. My original code identifies the rows in a correct way, it's something to do with copying.
If I change my code to just highlight the matching rows, it matches all the right rows:
If Len(.Value) = 8 Then .EntireRow.Interior.Color = 5296274
I'm sure there is a better way to do the copy/paste, which is where your issue is, but the below works.
Sub aims()
Dim i As Long
Dim vLastRow As Long
Dim s2 As Long
'find last row in sheet, or you could change to find last row in specified column
'Example: Cells = Columns(column number or letter), Cells(1, 1) = Cells(1, column number)
vLastRow = Cells.Find(what:="*", after:=Cells(1, 1), searchorder:=xlByRows, searchdirection:=xlPrevious).Row
s2 = 1
Application.ScreenUpdating = False
For i = 1 To vLastRow
If Trim(Len(CStr(Cells(i, 2)))) = 8 Then
Rows(i).EntireRow.Copy Destination:=Sheets(2).Range(Cells(s2, 1).Address)
s2 = s2 + 1
End If
Next i
Application.ScreenUpdating = True
End Sub
You can try something like this. The below code attempts to copy everything at once instead of having many instances of copy/paste. The two tests are seeing if the trimmed value has a character length of 8 OR if the trimmed value has a character length of 9 but the last character is the apostrophe. If either of these criteria are met, we will add that cell to a Union.
Once the code has looped through all rows, it will copy the entire union at all once
Option Explicit
Sub shooter()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1") '<-- Update
Dim LR As Long, i As Long, Add As Boolean, CopyMe As Range
Dim x As Range
LR = ws.Range("B" & ws.Rows.Count).End(xlUp).Row
For Each x In ws.Range("B2:B" & LR)
Add = False
If Len(Trim(x)) = 8 Then
Add = True
ElseIf Len(Trim(x)) = 9 And Right(Trim(x), 1) = "'" Then
Add = True
End If
If Add Then
If Not CopyMe Is Nothing Then
Set CopyMe = Union(CopyMe, x)
Else
Set CopyMe = x
End If
End If
Next x
If Not CopyMe Is Nothing Then
CopyMe.EntireRow.Copy Destination:=Sheets(2).Range(“A1”)
End If
End Sub
I'm having a little trouble with finding the last row.
What I am trying to do is find the last row in column "A", then use that to find the last row within a range.
Example of Data:
1) LR_wbSelect = wbshtSelect.cells(Rows.count, "A").End(xlUp).Row - 22
2) LR_wbSelectNew = wbshtSelect.cells(LR_wbSelect, "A").End(xlUp).Row
I am using the last row in column "A" as the data from row 29 down will always be the same length, the rows used in column "B" from row 29 can be a varying number of rows.
So I am trying to use LR_wbSelect in column "A" to get my starting last Row, then within LR_wbSelectNew using it as the starting point to look up from.
This works when the column I set to "A", LR_wbSelectNew gives me the row of "17", but when I change the column in LR_wbSelectNew to "B" it doesn't give the correct last row of "18".
I can change the column to "C, D, E, F" and the code works fine, but the only column that I can use is "B" because it will always have data in it, where the rest of that row could have a blank cell.
After doing some testing on the sheet, by pressing CRTL & Up from the lastring point of LR_wbSelect column "B" ignores the data in the rows and go to the row where it find data. I can't see a reason why Excel doesn't think there is data in these cells?
There are mulitple results and methods when searching for the LastRow (in Column B).
When using Cells(.Rows.Count, "B").End(xlUp).Row you will get the last row with data in Column B (it ignores rows with spaces, and goes all the way down).
When using:
With wbshtSelect.Range("B10").CurrentRegion
LR_wbSelectNew = .Rows(.Rows.Count).Row
End With
You are searching for the last row with data in Column B of the CurrentRegion, that starts from cell B10, untill the first line without data (it stops on the first row with empty row).
Full Code:
Sub GetLastRow()
Dim wbshtSelect As Worksheet
Dim LR_wbSelectNew As Long
' modify "Sheet2" to your sheet's name
Set wbshtSelect = Sheets("Sheet2")
' find last row with data in Column B
With wbshtSelect
LR_wbSelectNew = .Cells(.Rows.Count, "B").End(xlUp).Row
End With
' for debug only
Debug.Print LR_wbSelectNew ' >>result 31
' find last row with data in Column B at current regioun starting at cell B10
With wbshtSelect.Range("B10").CurrentRegion
LR_wbSelectNew = .Rows(.Rows.Count).Row
End With
' for debug only
Debug.Print LR_wbSelectNew ' >> result 18
End Sub
Edit1: code searches for last row for cells with values (it ignores blank cells with formulas inside).
Sub GetLastRow()
Dim wbshtSelect As Worksheet
Dim LR_wbSelectNew As Long
' modify "Sheet2" to your sheet's name
Set wbshtSelect = Sheets("Sheet2")
' find last row with data in Column B at current regioun starting at cell B10
With wbshtSelect.Range("B10").CurrentRegion
LR_wbSelectNew = .Rows(.Rows.Count).Row
End With
Dim Rng As Range
Set Rng = wbshtSelect.Range("B10:B" & LR_wbSelectNew)
' find last row inside the range, ignore values inside formulas
LR_wbSelectNew = Rng.Find(What:="*", _
After:=Range("B10"), _
LookAt:=xlPart, _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
' for debug
Debug.Print LR_wbSelectNew ' << result 18 (with formulas in the range)
End Sub
Hope this piece of code helps !
Sub LastRowInOneColumn()
'Find the last used row in a Column: column A in this example
Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
MsgBox LastRow
End Sub
I came here looking for a way to find the last row in a non-contiguous range. Most responses here only check one column at a time so I created a few different functions to solve this problem. I will admit, though, that my .Find() implementation is essentially the same as Shai Rado's answer.
Implementation 1 - Uses Range().Find() in reverse order
Function LastRowInRange_Find(ByVal rng As Range) As Long
'searches range from bottom up stopping when it finds anything (*)
Dim rngFind As Range
Set rngFind = rng.Find( What:="*", _
After:=rng.Parent.Cells(rng.row, rng.Column), _
LookAt:=xlWhole, _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious)
If Not rngFind Is Nothing Then
LastRowInRange_Find = rngFind.row
Else
LastRowInRange_Find = rng.row
End If
End Function
Implementation 2 - Uses Range().End(xlUp) on each column
Function LastRowInRange_xlUp(ByVal rng As Range) As Long
Dim lastRowCurrent As Long
Dim lastRowBest As Long
'loop through columns in range
Dim i As Long
For i = rng.Column To rng.Column + rng.Columns.count - 1
If rng.Rows.count < Rows.count Then
lastRowCurrent = Cells(rng.row + rng.Rows.count, i).End(xlUp).row
Else
lastRowCurrent = Cells(rng.Rows.count, i).End(xlUp).row
End If
If lastRowCurrent > lastRowBest Then
lastRowBest = lastRowCurrent
End If
Next i
If lastRowBest < rng.row Then
LastRowInRange_xlUp = rng.row
Else
LastRowInRange_xlUp = lastRowBest
End If
End Function
Implementation 3 - Loops through an Array in reverse order
Function LastRowInRange_Array(ByVal rng As Range) As Long
'store range's data as an array
Dim rngValues As Variant
rngValues = rng.Value2
Dim lastRow As Long
Dim i As Long
Dim j As Long
'loop through range from left to right and from bottom upwards
For i = LBound(rngValues, 2) To UBound(rngValues, 2) 'columns
For j = UBound(rngValues, 1) To LBound(rngValues, 1) Step -1 'rows
'if cell is not empty
If Len(Trim(rngValues(j, i))) > 0 Then
If j > lastRow Then lastRow = j
Exit For
End If
Next j
Next i
If lastRow = 0 Then
LastRowInRange_Array = rng.row
Else
LastRowInRange_Array = lastRow + rng.row - 1
End If
End Function
I have not tested which of these implementations works fastest on large sets of data, but I would imagine that the winner would be _Array since it is not looping through each cell on the sheet individually but instead loops through the data stored in memory. However, I have included all 3 for variety :)
How to use
To use these functions, you drop them into your code sheet/module, specify a range as their parameter, and then they will return the "lowest" filled row within that range.
Here's how you can use any of them to solve the initial problem that was asked:
Sub answer()
Dim testRange As Range
Set testRange = Range("A1:F28")
MsgBox LastRowInRange_Find(testRange)
MsgBox LastRowInRange_xlUp(testRange)
MsgBox LastRowInRange_Array(testRange)
End Sub
Each of these will return 18.
If your wbshtSelect is defined as worksheet and you have used set to define the specific worksheet, you can use this.
Dim LastRow As Long
wbshtSelect.UsedRange ' Refresh UsedRange
LastRow = wbshtSelect.UsedRange.Rows(wbshtSelect.UsedRange.Rows.Count).Row
Otherwise take a look here http://www.ozgrid.com/VBA/ExcelRanges.htm
LR_wbSelectNew = wbshtSelect.cells(LR_wbSelect, "B").End(xlUp).Row
Why are you using "LR_wbSelect" as the row counter? If you want to know the last row of column 'B', you should use Rows.count
Rows.count --> Returns maximum number of rows (which is 1048576 for Excel 2007 and up)
End(xlUp) --> Moves the pointer upward to the last used row
So,
cells(Rows.count, "A").End(xlUp).Row --> This moves the pointer to the last row if the column 'A' (as if you are pressing Crtl+Up keys when A1048576 cell is selected)
So, use Rows.count to select the last row for column 'B' as well. If you have some specific requirement related to LR_wbSelect, please mention it.
Alternatively, if you want to know the last row used in a sheet, you may use the below:
mySheet.Cells.SpecialCells(xlCellTypeLastCell).Row
LR_wbSelect = ThisWorkbook.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
Simple function that return last row no. in specific sheet.
It takes the last address in UsedRange and retrieve last row number.
Feel to free change the code and use standard range insead of UsedRange.
Function FindLastRow(wsToCheck As Worksheet) As Long
Dim str As String
str = wsToCheck.UsedRange.AddressLocal()
FindLastRow = Right(str, InStr(1, StrReverse(str), "$") - 1)
End Function
Range().End will bring you to the end of a code block. If the starting cell is empty, it brings you the the first used cell or the last cell. It the cells is not empty it brings you to the last used cell. For this reason, you need to test whether or not the cell in column B is to determine whether to use LR_wbSelectNew as the last row.
With wbshtSelect
LR_wbSelect = .Cells(Rows.Count, "A").End(xlUp).Row - 22
If .Cells(LR_wbSelect, "B") <> "" Then
LR_wbSelectNew = LR_wbSelect
Else
LR_wbSelectNew = .Cells(LR_wbSelect, "B").End(xlUp).Row
End If
End With
This code defines a Target range that extends from A1 to the last row in column a - 22 and extends 10 columns.
Dim Target As Range
With wbshtSelect
Set Target = .Range("A1", .Cells(Rows.Count, "A").End(xlUp).Offset(-22)).Resize(, 10)
End With
'This is sure method to find or catch last row in any column even 'if some cell are blank in-between. (Excel-2007)`
'This works even if sheet is not active
'mycol is the column you want to get last row number
for n=1048575 to 1 step -1
myval=cells(n,mycol)
if myval<>"" then
mylastrow=n 'this is last row in the column
exit for
end if
next
ret=msgbox("Last row in column-" & mycol & "is=" & mylastrow)
Dim rng As Range
Dim FirstRow, LastRow As long
Set rng = Selection
With rng
FirstRow = ActiveCell.Row
LastRow = .Rows(.Rows.Count).Row
End With
Shai Rado's first solution is a great one, but for some it might need a bit more elaboration:
Dim rngCurr, lastRow
rngCurr = wbshtSelect.Range("B10").CurrentRegion
lastRow = rngCurr.Rows(rngCurr.Rows.Count).Row
If you want to know the last used row in the entire worksheet:
Dim rngCurr, lastRow
rngCurr = Range("A1").CurrentRegion
lastRow = rngCurr.Rows(rngCurr.Rows.Count).Row
Backing off from the range to the worksheet will get you the whole sheet extents of the range used on the sheet (which may be smaller than you expect if the sheet doesn't have data in the top rows; but it does include internal blanks)
TheRange.Worksheet.UsedRange.Rows.Count
If there is no data in the top rows, the following will get you the first row which you need to add to the above to get the highest row number
TheRange.End(xlDown).Row
So
Dim TheRange as Range
Dim MaxRow as Long
MaxRow = TheRange.Worksheet.UsedRange.Rows.Count + TheRange.End(xlDown).Row
Will get the highest row number with data (but not the whole sheet)
Before getting into complex coding why not build something on the below principle:
MaxRow = Application.Evaluate("MIN(ROW(A10:C29)) + ROWS(A10:C29) - 1")
Here's my problem: I want to bold entire rows of my spreadsheet IF the value of one of the columns equals either 'Saturday' or 'Sunday'. I've found ways to bold the cells, but not the entire row. Can someone please help?
Oh, I would also like to increase the font, from 10 to 12, based on same condition.
Thanks!
So ... I got a bit bored and made this for you
Sub Test()
Dim cRow as Long
Dim rRow As Range
Dim LastRow As Long
'Gets the last row with data in it
LastRow = [A65000].End(xlUp).Row
'the look to move down the cells
For cRow = 1 To LastRow
'if statment so catch the values that are wanted
If Cells(cRow, 1) = "Saturday" Or Cells(cRow, 1) = "Sunday" Then
'the changes made to the rows
Rows(cRow).Font.Bold = True
Rows(cRow).Font.Size = 12
End If
Next cRow
End Sub
Brief explincation, the LastRow gets the last row in column A (this is needed so we dont go past any of the data we need and intoblank cells (Change the column letter to which ever column you need))
The loop For cRow = 1 To LastRow (the cRow will +1 for each Next cRow) will count down the cells till it reachs the LastRow
The If Cells(cRow, 1) = "Saturday" Or Cells(cRow, 1) = "Sunday" Then will check the cell and if it has the value in the cell it will then change it to bold and size 12 font
If there is anything you are unclear of in the code let me know and I will try to clarify
Private TurnRowToBold()
lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lLastRow
If (Worksheets("MySheet").Cells(i, 1) = "Saturday" or Worksheets("MySheet").Cells(i, 1) = "Sunday") Then
Worksheets("MySheet").Rows(i).Font.Bold = True
Worksheets("MySheet").Rows(i).Font.Size = 12
End If
Next
End Sub