Excel spreadsheet checking which row contains contains data - excel

I have a vb.net application from which I open an excel spreadsheet that contains data. I copy all the data and insert it into sql server. I'm coming across a small issue with finding the last row. Here's how I've been doing it right now...
Dim lastRow As Long = 0
lastRow = xlws.Cells.SpecialCells(XlCellType.xlCellTypeLastCell, Type.Missing).Row
This finds the last row for me but often times, the spreadsheet might contain data that is not relevant to what I'm trying to insert into my table - in this case it's a confidentiality statement at the last row of the spreadsheet. So what i'm trying to do is set the last row to whatever the last row of ACTUAL data is. This is what it looks like...
So in this case - i want the last row to be recognized to be row 11 rather than row 13. The thing is - the formatting of the report might be slightly different (for the confidentiality statement) so often times it might start in column A or B and be merged (possibly) or they might write it elsewhere.
Another thing is that Column A and B of data (ending at row 11) might sometimes not have a value. How should I go about something like this?
EDIT:
This is what I'm coming up with - Hate GoTo's but....
LastRowCheck:
If CStr(excel.Cells(lastRow, 4).Value) = "" And CStr(excel.Cells(lastRow, 5).value) = "" And CStr(excel.Cells(lastRow, 6).value) = "" Then
lastRow += -1
goto LastRowCheck
End If

How about:
Sub TheTrueLastRow()
Dim i As Long
For i = 1 To Rows.Count
If Cells(i, "B").Value = "" Or Cells(i, "E").Value = "" Then
lastRow = i - 1
Exit For
End If
Next i
MsgBox lastRow
End Sub

Maybe something like this:
Sub Test()
MsgBox LastRow(ThisWorkbook.Worksheets(2))
End Sub
Public Function LastRow(wrkSht As Worksheet) As Long
Dim rLastCell As Range
Dim lLastCol As Long, lLastRow As Long
Dim rCol As Range
On Error Resume Next
With wrkSht
lLastCol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
lLastRow = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
If lLastCol = 0 Then lLastCol = 1
If lLastRow = 0 Then lLastRow = 1
Set rLastCell = .Cells(lLastRow, lLastCol)
'Look at each column, if the last cell is merged then look up from there,
'otherwise leave the last row as it is.
For Each rCol In .Range(.Cells(rLastCell.Row, 1), rLastCell).Columns
If rCol.MergeCells Then
LastRow = rCol.End(xlUp).Row
Exit For
Else
LastRow = rLastCell.Row
End If
Next rCol
End With
On Error GoTo 0
End Function
Edit: Just noticed, it will fail at this point (well, if the last column is shorter rather than the first two).
Another thing is that Column A and B of data (ending at row 11) might
sometimes not have a value. How should I go about something like this?

If you have a column that has data in each row of the table and the there is an empty cell between that on wanted data
xlws.Range("B1").End(Excel.XlDirection.xlDown).Row
Alternately, you can take the bottom up approach if the only there is no unwanted data at the end of a column.
xlws.Range("B" & xlws.Rows.Count).End(Excel.XlDirection.xlUp).Row

Related

VBA : deleteing the information from sheet

I'm wondering if there is more efficient way to clean my sheet. My code takes a long time to run (I have 5000 observations ):
Dim Num_Ligne As Long
Num_Ligne = 8
While Cells(Num_Ligne, 3) <> ""
ActiveSheet.Cells(Num_Ligne, 3).Value = ""
ActiveSheet.Cells(Num_Ligne, 4).Value = ""
ActiveSheet.Cells(Num_Ligne, 5).Value = ""
ActiveSheet.Cells(Num_Ligne, 6).Value = ""
ActiveSheet.Cells(Num_Ligne, 7).Value = ""
ActiveSheet.Cells(Num_Ligne, 8).Value = ""
ActiveSheet.Cells(Num_Ligne, 9).Value = ""
ActiveSheet.Cells(Num_Ligne, 10).Value = ""
Num_Ligne = Num_Ligne + 1
Wend
Thank you for your help !
Clear Contents of a Range
Requirements
Clear the contents of a range.
OP's Solution
Loop through each cell and test if it is empty. Then loop through each column and clear its contents. For 5000 records it tests 5000 times a cell if it is blank and clears the contents of a cell 40.000 times which takes about 10s on my machine.
Solution
Create a reference to all those cells and clear the contents in one go.
The first solution is a 'flavor' of BigBen's solution in the comments which is widely used (popular) and is based on the End property. This (my) solution uses Resize ('flavor').
The second solution is a more reliable version that uses the Find method which may only fail if the worksheet is filtered. The End solution will additionally fail if the last cell on the worksheet is occupied (highly unlikely), if the last row is less than the specified first row (unlikely), and if there are hidden rows (unlikely).
The third solution is kind of a study of the second solution.
For even more insights, study the legendary Siddharth Rout's answer to Error in finding last used cell in Excel with VBA.
The Code
Option Explicit
Sub RangeClearContentsEnd()
Const Cols As String = "C:J"
Const FirstRow As Long = 8
With ActiveSheet.Columns(Cols)
Dim LastRow As Long
LastRow = .Columns(1).Cells(.Rows.Count).End(xlUp).Row
.Rows(FirstRow).Resize(LastRow - FirstRow + 1).ClearContents
End With
End Sub
Sub RangeClearContentsFind()
Const Cols As String = "C:J"
Const FirstRow As Long = 8
With ActiveSheet.Columns(Cols).Rows(FirstRow)
Dim cel As Range
Set cel = .Resize(.Worksheet.Rows.Count - FirstRow + 1, 1) _
.Find("*", , xlFormulas, , , xlPrevious)
If Not cel Is Nothing Then
.Resize(cel.Row - FirstRow + 1).ClearContents
End If
End With
End Sub
Sub RangeClearContentsFindStudy()
Const Cols As String = "C:J"
Const FirstRow As Long = 8
' Define the first row (range) of the range.
Dim rrg As Range: Set rrg = ActiveSheet.Columns(Cols).Rows(FirstRow)
Debug.Print "First Row of the Range : " & rrg.Address(0, 0)
' Define the range referring to the first column from
' the specified first row to the bottom-most row of the worksheet.
Dim frg As Range
Set frg = rrg.Resize(ActiveSheet.Rows.Count - FirstRow + 1, 1)
Debug.Print "First Column to the Bottom: " & frg.Address(0, 0)
' Attempt to find the last non-empty cell in it.
Dim lCell As Range
Set lCell = frg.Find("*", , xlFormulas, , , xlPrevious)
' Validate the last non-empty cell.
If Not lCell Is Nothing Then
Debug.Print "Last Non-Empty Cell: " & lCell.Address(0, 0)
' Define the range from the first specified row
' to the last non-empty cell's row.
Dim drg As Range: Set drg = rrg.Resize(lCell.Row - FirstRow + 1)
Debug.Print "Delete Range: " & drg.Address(0, 0)
' Clear its contents.
drg.ClearContents
Else
Debug.Print "Nothing cleared."
End If
End Sub
The Requirements: To clear the contents of a range.
The Data: The data involved contains a mix of cells (i.e:, some cells have content, others are empty), as could be understood from this line in the question code While Cells (Num_Ligne, 3) <>"".
The figure below represents a sample of the data. There we have cells with a constant value (X), cells with formulas (filled with a pattern), and all other cells are empty. In this sample data the Last Row is the Row 26.
Now let's look at some of the methods to obtain the last row in line with the data involved.
End(xlUp).Row method: In this case, I would suggest not using this method unless it is applied to each of the columns involved, but then it won't be practical.
When applied only to the first column, it returns row 25, instead of row 26.
Find method: In this case, this method will only be effective if it is applied to the entire range.
When applied only to the first column, it also returns row 25.
When applied to the entire range [C:J] it will return the correct row 26.
However, if the last time the Find method was utilized the SearchOrder applied was xlByColumns, then when we run our procedure the method will return row 25, if the SearchOrder was not set to xlByRows in our procedure.
Bear in mind that the LookIn, LookAt, SearchOrder and MatchByte* parameters are saved each time the Find method is applied, therefore these parameters should always be included (*if applicable) to ensure the expected return.
UsedRange: This is one of the few cases where this worksheet property could be used. As in this case, the objective is to set a range from an initial row to the last row with contents of specific columns and then clear the contents of that range. Actually utilizing the UsedRange simplifies the code a lot.
With ActiveSheet
Range(.Rows(8), .Rows(.UsedRange.SpecialCells(xlCellTypeLastCell).Row)).Columns("C:J").ClearContents
End With
Last Row? However, each problem has its own peculiarities, and for this particular problem we should also ask ourselves the question:
In this case, is the last row really necessary?
I think the answer is no. So let's simplify things even more.
With ActiveSheet
Range(.Rows(8), .Rows(.Rows.Count)).Columns("C:J").ClearContents
End With
You have options:
Sub test()
Dim Num_Ligne As Long
Num_Ligne = 8
While Cells(Num_Ligne, 3) <> ""
'ActiveSheet.Cells(Num_Ligne, 3).EntireRow.Clear
ActiveSheet.Range("C" & Num_Ligne & ":J" & Num_Ligne).Clear
Num_Ligne = Num_Ligne + 1
Wend
End Sub

Excel Loop Through all filled cells in row 1

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

Trouble finding last column from a data-ridden sheet

I've tried to figure out the last used column in my excel spreadsheet using VBA to start writing something right after that column. In the image below I've tried to show what I meant and where I wanna start writing from. The desired field is already selected there which is "F2".
However, the problem is the data already available there did not maintain uniformity. How can I figure out the last used column using VBA?
This is my try:
Sub FindLastColumn()
Dim lCol&
lCol = Cells(1, Columns.Count).End(xlToLeft).Column
MsgBox lCol
End Sub
It produces 8 as result which is not correct as the right one should be 5.
The data-ridden sheet looks like below:
If you want to find the last column in your range excluding the header, you could achieve that as below, amend the Sheet name from Sheet1 to the Sheet you are actually using:
Sub foo()
LastRow = Sheet1.UsedRange.Rows.Count
'get the last row with data in your used range
MaxCol = 1
For i = 2 To LastRow 'loop from row 2 to last
If Sheet1.Cells(i, Sheet1.Columns.Count).End(xlToLeft).Column > MaxCol Then
MaxCol = Sheet1.Cells(i, Sheet1.Columns.Count).End(xlToLeft).Column
'get the highest value for the column into variable
End If
Next i
MsgBox MaxCol
End Sub
It appears that you want to find the right-hand most used column in rows 2 to the end of your data. To do that, you'll need to loop through all the rows of data keeping track of which column is Max(LastUsedColumn). Unfortunately, there is no such built in function, but you could write one something like this:
Public Function MaxUsedColumnInRow(ByVal SheetToCheck As Worksheet, ByVal RowToCheck As Long) As Long
MaxUsedColumnInRow = SheetToCheck.Cells(RowToCheck, Columns.count).End(xlToLeft).Column
End Function
Now that you have a nifty function to determine which is the maximum used column in a row, you can call it in a loop, like this:
Public Function MaxUsedColumnInRange(ByVal SheetToCheck As Worksheet, ByVal StartRow As Long, ByVal EndRow As Long) As Long
Dim curRow As Long
For curRow = StartRow To EndRow
Dim CurCol As Long
CurCol = MaxUsedColumnInRow(SheetToCheck, curRow)
Dim maxCol As Long
If CurCol > maxCol Then
maxCol = CurCol
End If
Next
End Function
And, finally, give it a quick test replacing "Sheet1" with the name of the worksheet you're specifically checking:
Public Sub TestIt()
MsgBox "Max Used column on sheet1 = " & CStr(MaxUsedColumnInRange("Sheet1", 2, 50))
End Sub
Of course, you'll want to determine the max used row on your sheet and pass that into the the MaxUsedColumnInRange function - unless you happen to have exactly 50 rows of data, the example test Sub probably won't get you your actual desired result.
As a side benefit, you now have a handy function you can call in the future to determine the max column in a row so you don't have to remember the proper way of doing it. (I usually forget so I have to look it up, or use a nifty helper function to "remember" for me.)
Use a variation of the Find method of finding it, but limit it to ignore row 1:
Sub Test()
Dim rng As Range
Set rng = LastCell(Sheet1)
MsgBox "Last cell containing data is " & rng.Address & vbCr & _
"Selected cell is in example is " & Sheet1.Cells(2, rng.Column + 1).Address
End Sub
Public Function LastCell(wrkSht As Worksheet) As Range
Dim lLastCol As Long, lLastRow As Long
On Error Resume Next
With wrkSht.Rows("2:1048576")
lLastCol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
lLastRow = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
If lLastCol = 0 Then lLastCol = 1
If lLastRow = 0 Then lLastRow = 1
Set LastCell = wrkSht.Cells(lLastRow, lLastCol)
End With
On Error GoTo 0
End Function
Easy route would be to use Find like below:
Dim rgLastColumnCell As Range
Set rgLastColumnCell = ActiveSheet.Cells.Find("*", , , , xlByColumns, xlPrevious)
MsgBox "Last Used Column is : " & rgLastColumnCell.Column
Adjust ActiveSheet.Cells portion to suit your need like: Activesheet.Range("B2:XFD1048576") if you want to skip first row from the check.
You cannot get the result you require by using built-in functions, either you can get the column H because it is the last used column or the column B, because it is the last filled column, To get E you have to write your own code, and by the look of it, it seems that you want the end of the colored range. You can check the last column where color is not present in a loop
Sub checkLastColumn()
col_num = 1
Do While Cells(2, col_num).Interior.Pattern <> xlNone
col_num = col_num + 1
Loop
MsgBox col_num
End Sub
It will return column F
EDIT....
As I said earlier you cannot get the cell you require by any built-in function, you have to write some code, and in order to do that you must have a definite logic that should be known and decided between you and the users of the sheet.
For example:
you can color the range as you have already done
You can name the column header, as in your example, it is status.
You can fix the number of data columns and status columns, and there will be no need to use any code
For finding the status column or any other if you decide you can use a loop as below
Sub getStatusColumn()
col_num = 1
Do While Cells(1, col_num) <> "status"
col_num = col_num + 1
Loop
MsgBox col_num
End Sub
OR
Sub getLastItemColumn()
col_num = 1
Do While Left(Cells(1, col_num), 4) = "Item"
col_num = col_num + 1
Loop
MsgBox col_num
End Sub

Find last row in range

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")

How to make a loop clear cache every 100,000 loops?

I have taken a code posted here somewhere and inserted an If statement that basically makes the sheet save every 10,000 loops. I read an advice somewhere that this stops excel from crashing completely. I am basically trying to match columns and finding duplicates by highlighting them/copying.
The issues is both columns that I am comparing have 100,000 rows each. I have been running the code for 4 hours now and it has only produced 1000 lines of matches... I am expecting at least 15,000 matches.
This time penalty is getting ridiculous, I am pretty sure there is a faster way to do it, but I am no expert in coding. :(
Sub Compare()
Dim Report As Worksheet
Dim i, j, z, colNum, vMatch As Integer
Dim lastRowA, lastRowB, lastRow, lastColumn As Integer
Dim ColumnUsage As String
Dim colA, colB, colC As String
Dim A, B, C As Variant
Set Report = Excel.ActiveSheet
vMatch = 1
'Select A and B Columns to compare
On Error Resume Next
Set A = Application.InputBox(Prompt:="Select column to compare", Title:="Column A", Type:=8)
If A Is Nothing Then Exit Sub
colA = Split(A(1).Address(1, 0), "$")(0)
Set B = Application.InputBox(Prompt:="Select column being searched", Title:="Column B", Type:=8)
If A Is Nothing Then Exit Sub
colB = Split(B(1).Address(1, 0), "$")(0)
'Select Column to show results
Set C = Application.InputBox("Select column to show results", "Results", Type:=8)
If C Is Nothing Then Exit Sub
colC = Split(C(1).Address(1, 0), "$")(0)
'Get Last Row
lastRowA = Report.Cells.Find("", Range(colA & 1), xlFormulas, xlByRows, xlPrevious).row - 1 ' Last row in column A
lastRowB = Report.Cells.Find("", Range(colB & 1), xlFormulas, xlByRows, xlPrevious).row - 1 ' Last row in column B
Application.ScreenUpdating = False
'***************************************************
For i = 3 To lastRowA 'change this NUMBER depending on which row the data starts
For j = 3 To lastRowB
z = j / 10000
If Report.Cells(i, A.Column).Value <> "" Then
If InStr(1, Report.Cells(j, B.Column).Value, Report.Cells(i, A.Column).Value, vbTextCompare) > 0 Then
vMatch = vMatch + 1
Report.Cells(i, A.Column).Interior.ColorIndex = 35 'Light green background
Range(colC & 1).Value = "Items Found"
Report.Cells(i, A.Column).Copy Destination:=Range(colC & vMatch)
If j = Int(j) Then
ThisWorkbook.Save
Exit For
Else
'Do Nothing
End If
End If
End If
Next j
Next i
If vMatch = 1 Then
MsgBox Prompt:="No Items Found", Buttons:=vbInformation
End If
'***************************************************
Application.ScreenUpdating = True
End Sub
Looking at your code... a few points:
Why not make A, B, C as string which hold the column you are looking at? This will increase performance. There is no need for the split and when you are looping instead of A.column you can just write A.
Are you trying to find complete matches (as oppose to a match in part of the text)? If so, set the values into a variable e.g. aValue = Report.Cells(j, A).Value and bValue = Report.Cells(j, B).Value and then compare them using if aValue = bValue then
Are you comparing one column against another, and then displaying results in a third column if there is a match in the SAME row? If so, what is the purpose of the j loop? Just loop through i (which will be your row) and compare value in both column A and column B.
If value can be on any row in the second column, then yes you can use the j loop, but an even faster way will be to use Excel in-built find function in VBA where you will search your value on column B:B. Using Excel Find in VBA is significantly faster.
What is z?
Worksheet save will only fail if bigger than the bounds of type Int. Is that what you want?
Your indentation needs to be corrected.
Exit For
Else
'Do Nothing
End If
Above needs to be indented 2-3 times
Implement the above improvements and let me know how you get on. Good luck.

Resources