Related
I am trying to find the last row the same way I found the last column:
Sheets("Sheet2").Cells(1,Sheets("Sheet2").Columns.Count).End(xlToLeft).Column
I know this way but it is not as helpful as the prior would be:
u = Sheets("Sheet1").Range("A65536").End(xlUp).Row
I tried:
Sheets("Sheet2").Cells(Sheets("Sheet2",1).Rowa.Count).End(xlToUP).Column
Synopsis: I would like the below way for last row.
Sheets("Sheet2").Cells(1,Sheets("Sheet2").Columns.Count).End(xlToLeft).Column
You should use a with statement to qualify both your Rows and Columns counts. This will prevent any errors while working with older pre 2007 and newer 2007 Excel Workbooks.
Last Column
With Sheets("Sheet2")
.Cells(1, .Columns.Count).End(xlToLeft).Column
End With
Last Row
With Sheets("Sheet2")
.Range("A" & .Rows.Count).End(xlUp).Row
End With
Or
With Sheets("Sheet2")
.Cells(.Rows.Count, 1).End(xlUp).Row
End With
How is this?
dim rownum as integer
dim colnum as integer
dim lstrow as integer
dim lstcol as integer
dim r as range
'finds the last row
lastrow = ActiveSheet.UsedRange.Rows.Count
'finds the last column
lastcol = ActiveSheet.UsedRange.Columns.Count
'sets the range
set r = range(cells(rownum,colnum), cells(lstrow,lstcol))
This function should do the trick if you want to specify a particular sheet. I took the solution from user6432984 and modified it to not throw any errors. I am using Excel 2016 so it may not work for older versions:
Function findLastRow(ByVal inputSheet As Worksheet) As Integer
findLastRow = inputSheet.cellS(inputSheet.Rows.Count, 1).End(xlUp).Row
End Function
This is the code to run if you are already working in the sheet you want to find the last row of:
Dim lastRow as Integer
lastRow = cellS(Rows.Count, 1).End(xlUp).Row
I use this routine to find the count of data rows. There is a minimum of overhead required, but by counting using a decreasing scale, even a very large result requires few iterations. For example, a result of 28,395 would only require 2 + 8 + 3 + 9 + 5, or 27 times through the loop, instead of a time-expensive 28,395 times.
Even were we to multiply that by 10 (283,950), the iteration count is the same 27 times.
Dim lWorksheetRecordCountScaler as Long
Dim lWorksheetRecordCount as Long
Const sDataColumn = "A" '<----Set to column that has data in all rows (Code, ID, etc.)
'Count the data records
lWorksheetRecordCountScaler = 100000 'Begin by counting in 100,000-record bites
lWorksheetRecordCount = lWorksheetRecordCountScaler
While lWorksheetRecordCountScaler >= 1
While Sheets("Sheet2").Range(sDataColumn & lWorksheetRecordCount + 2).Formula > " "
lWorksheetRecordCount = lWorksheetRecordCount + lWorksheetRecordCountScaler
Wend
'To the beginning of the previous bite, count 1/10th of the scale from there
lWorksheetRecordCount = lWorksheetRecordCount - lWorksheetRecordCountScaler
lWorksheetRecordCountScaler = lWorksheetRecordCountScaler / 10
Wend
lWorksheetRecordCount = lWorksheetRecordCount + 1 'Final answer
This gives you the last used row in a specified column.
Optionally you can specify the worksheet, otherwise it will take the active sheet.
Function getLastRow(col As Integer, Optional ws As Worksheet) As Long
If ws Is Nothing Then Set ws = ActiveSheet
If ws.Cells(ws.Rows.Count, col).Value <> "" Then
getLastRow = ws.Cells(ws.Rows.Count, col).Row
Exit Function
End If
getLastRow = ws.Cells(Rows.Count, col).End(xlUp).Row
If shtRowCount = 1 Then
If ws.Cells(1, col) = "" Then
getLastRow = 0
Else
getLastRow = 1
End If
End If
End Function
Sub test()
Dim lgLastRow As Long
lgLastRow = getLastRow(2) 'Column B
End Sub
This is the best way I've seen to find the last cell.
MsgBox ActiveSheet.UsedRage.SpecialCells(xlCellTypeLastCell).Row
One of the disadvantages to using this is that it's not always accurate. If you use it then delete the last few rows and use it again, it does not always update. Saving your workbook before using this seems to force it to update though.
Using the next bit of code after updating the table (or refreshing the query that feeds the table) forces everything to update before finding the last row. But, it's been reported that it makes excel crash. Either way, calling this before trying to find the last row will ensure the table has finished updating first.
Application.CalculateUntilAsyncQueriesDone
Another way to get the last row for any given column, if you don't mind the overhead.
Function GetLastRow(col, row)
' col and row are where we will start.
' We will find the last row for the given column.
Do Until ActiveSheet.Cells(row, col) = ""
row = row + 1
Loop
GetLastRow = row
End Function
Problems with normal methods
Account for Blank Rows / Columns -
If you have blank rows or columns at the beginning of your data then methods like UsedRange.Rows.Count and UsedRange.Columns.Count will skip over these blank rows (although they do account for any blank rows / columns that might break up the data), so if you refer to ThisWorkbook.Sheets(1).UsedRange.Rows.Count you will skip lines in cases where there are blank rows at the top of your sheet, for example on this sheet:
This will skip the top row from the count and return 11:
ThisWorkbook.Sheets(1).UsedRange.Rows.Count
This code will include the blank row and return 12 instead:
ThisWorkbook.Sheets(1).UsedRange.Cells(ThisWorkbook.Sheets(1).UsedRange.Rows.Count, 1).Row
The same issue applies to columns.
Full Sheets -
Identifying the last row or column can be difficult if your sheet is full (this only matters if either your data contains over a million lines or might have values in the final rows or columns of your data). For example, if you use xlEndUp or similar and the cell you're referring to is populated then the code will skip over data, in extreme cases your entire data set can be skipped if for example the data continues from the last row of the sheet (where you start your xlEndUp) solidly up to the first row (in this case the result would be 1).
'This code works, but...
'Will not function as intended if there is data in the cell you start with (Cell A:1048576).
Dim Sht1 as Range: Set Sht1 = ThisWorkbook.Sheets(1)
Sht1.Cells(Sht1.Rows.Count, 1).End(xlUp).Row
Columns with blank rows -
The above code also assumes that your data extends the entire way down column 1, if you have blank entries in column 1 you may lose rows as the code will find the first filled row from the bottom only for column 1.
Unnecessary Looping -
Self explanatory, best to avoid looping where possible as if you're dealing with a lot of data and repeating the looping process often it can slow down your code.
Solution
Note that this is targeted at finding the last "Used" Row or Column on an entire sheet, this doesn't work if you just want the last cell in a specific range.
I've setup some Functions here
Private Function GetLastRow(Sheet As Worksheet)
'Gets last used row # on sheet.
GetLastRow = Sheet.UsedRange.Cells(Sheet.UsedRange.Rows.Count, 1).Row
End Function
Private Function GetLastCol(Sheet As Worksheet)
'Gets last used column # on sheet.
GetLastCol = Sheet.UsedRange.Cells(1, Sheet.UsedRange.Columns.Count).Column
End Function
Examples of calling these Functions:
Sub CallFunctions()
'Define the Target Worksheet we're interested in:
Dim Sht1 As Worksheet: Set Sht1 = ThisWorkbook.Sheets(1)
'Print the last row and column numbers:
Debug.Print "Last Row = "; GetLastRow(Sht1)
Debug.Print "Last Col = "; GetLastCol(Sht1)
End Sub
I preferred search last blank cell:
Il you want last empty cell of column you can do that
Dim sh as Worksheet, r as range
set sh = ActiveWorksheet 'if you want an other it's possible
'find a value
'Columns("A:D") 'to check on multiple columns
Set r = sh.Columns("A").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
'no value return first row
If r Is Nothing Then Set r = sh.Cells(1, "A") Else Set r = sh1.Cells(r.Row + 1, "A")
If this is to insert new row, find on multiple columns is a good choice because first column can contains less rows than next columns
I use the following function extensively. As pointed out above, using other methods can sometimes give inaccurate results due to used range updates, gaps in the data, or different columns having different row counts.
Example of use:
lastRow=FindRange("Sheet1","A1:A1000")
would return the last occupied row number of the entire range. You can specify any range you want from single columns to random rows, eg FindRange("Sheet1","A100:A150")
Public Function FindRange(inSheet As String, inRange As String) As Long
Set fr = ThisWorkbook.Sheets(inSheet).Range(inRange).find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
If Not fr Is Nothing Then FindRange = fr.row Else FindRange = 0
End Function
Edit: This question has been re-worked to provide better clarity of my problem.
There's 2 factors to my question.
First Factor: I have a validation list in a sheet called "Admin Sheet". In that list are 'Tasks'.
I would like to cross reference those tasks in the "list", against those contained in a range (rangeString) taken from another sheet and count the number of 'Occurrences' for each item.
i.e. Task 1 appears 3 times, Task 2 appears 1 time, etc etc..
Factor 2: For each item within the list I would also like to gather the number of 'Hours' spent on that task.
For example:
Task 1 may appear 3 times on 3 different rows within the range. On each row in another column are the hours spent on that particular task. I would like to 'Sum' those hours from the 3 rows and I'd like to do this for all the 'Tasks'.
Note: The range is variable and will change daily.
Note: The columns that contain the info are: 'F' - Tasks and 'K' for Hours.
My current attempt at just capturing 'one' Task and its Hours associated with it:
Dim PaintWWArray() As Variant
Dim PHoursCnt As Long
Set srchRng = ActiveSheet.Range(rangeString)
Set rngfindValue = srchRng.find(what:="AD PAINTING W/W", Lookat:=xlPart)
'Find all the Tasks and Hours
If Not rngfindValue Is Nothing Then
rngFirstAddress = rngfindValue.Address
Do
PaintWWCnt = PaintWWCnt + 1
PHoursCnt = rngfindValue.Offset(0, 4).Value
ReDim Preserve PaintWWArray(PHoursCnt)
PaintWWArray(PHoursCnt) = PHoursCnt
Set rngfindValue = srchRng.FindNext(rngfindValue)
Loop Until rngfindValue Is Nothing Or rngfindValue.Address = rngFirstAddress
PWWSum = Application.WorksheetFunction.Sum(PaintWWArray)
MsgBox PWWSum
End If
Once I have collected the number of 'Occurrences' for each Task and the Sum of the hours for each task, I want to pass them into another sheet.
Worksheets("Weekly Data").Range("C6").Value = PaintWWCnt
Worksheets("Weekly Data").Range("D6").Value = PWWSum
I hope this is clearer...
I would suggest using a Dictionary.
Assuming you want to count all words:
Dim myDict
Set myDict = CreateObject("Scripting.Dictionary")
' Go through the array
For Each addDuty In arr
' If you only want to count specific words, add in IF statement here
myDict(addDuty) = myDict(addDuty) + 1
Next addDuty
If you only want to count words in an exiting set, it becomes slightly more elaborate.
It's not entirely clear what you want to achieve but the code below should give you the data you need. It's very fast. Please try it.
Private Sub STO_Answer()
' 024
' this procedure requires a reference to be set to
' Microsoft Scripting Runtime
Dim Counter As Scripting.Dictionary ' store task names and their count
Dim Arr As Variant ' an array of the data in Rng
Dim CellVal As Variant ' temporary storage of each cell value
Dim R As Long ' row counter
Dim Key As Variant ' a dictionary Key
Arr = ActiveSheet.Range("C2:D27").Value ' change to name the sheet
' adjust the range to suit
Set Counter = New Scripting.Dictionary
With Counter
For R = 1 To UBound(Arr) ' loop through all rows
AddToCounter Arr(R, 1), Counter ' first column of cell range
AddToCounter Arr(R, 2), Counter ' second column of cell range
Next R
For Each Key In Counter.Keys
Debug.Print Key, Counter.Item(Key)
Next Key
End With
End Sub
Private Sub AddToCounter(CellVal As Variant, _
Counter As Scripting.Dictionary)
' 024
With Counter
If .Exists(CellVal) Then
.Item(CellVal) = .Item(CellVal) + 1
Else
.Add CellVal, 1
End If
End With
End Sub
A Dictionary is a data structure which holds two related values. Here it's used to hold the task name and the number of times it occurs. Make sure you enable the reference to Microsoft Scripting Runtime in Tools > References. You don't specify if there is any relationship- between the tasks in the first column and the second. The above code counts both independently for now.
The result is printed to the Immediate Window. Of course, you might use this result in any other way in your code. Your question doesn't cover your intentions.
You won't be able to escape from the necessity to present your count in some way forever. As it turns out, there is only one efficient way to do it. This one:-
All duties are in column A and all added duties are in row 2.
Of course, you might use rather elaborate VBA to do the counting but Excel has a better way using a worksheet function. In order to set up COUNTIF() to work I created two named ranges as follows.
["Duties"] =OFFSET(Sheet2!$C$2,0,0,COUNTA(Sheet2!$C:$C)-1)
and
["AddDuties"] =OFFSET(Duties,0,1)
Sheet2!$C$2 is where my data started. Replace with the first cell of the first column of your data range. COUNTA(Sheet2!$C:$C)-1 makes this range dynamic. The function counts how many entries there are in that same column, -1 because the count would include a caption (modify if you have more or fewer headers).
AddDuties is simply defined as "same as Duties" but removed by one column to the right. You could move it elsewhere. As you add or delete rows in the column of Duties, AddDuties expands or contracts right along.
Now the formula in B3 is shown below. It's copied down and across as required. Please observe the $ signs.
[B3] =COUNTIFS(Duties,$A3,AddDuties,B$2)
This will probably generate a lot of zeroes. It did in my example and I didn't like them. Therefore I formatted B3 with the Custom cell format 0;; before copying to the other cells, which hides them.
Now this list would automatically update as you make entries in your data. You will never have to run code and the list will always be ready.
Finally, one recommendation. All your added duties, like "AD PAINITNG H/R", are hard to type correctly. Therefore the user should select them from a validation drop-down when entering them in the data. Most probably, you already have a list somewhere which feeds such drop-downs. The captions in the count list must be taken from the same source. But that creates redundancy. The better way is to make the list in B2:H2 of the count list the "original". Name the range and make it dynamic and you will never have to think about this subject again.
i think a better approach would be to use for each loops, this way you won't have to hardcode the conditions via IfElse. If you have the values in column A of a sheet and wants to go through those values and get their adjacent value in column B, you can use For Each looping to go through each values defined in A to get B.
just to add, regarding on counting of occurrence, you can define a counter that would add up for each occurrence of a unique value in column A.
I do not have time to wait for clarifications I asked... I prepared a piece of code, starting from the assumption that your strings to be counted are in column "F:F", and the value to be calculated is in column "K:K". The processing result is dropped on the last available column of the active pages, starting from row 2. If you prefer some relevant headers for the two involved columns, this can be easily automated. I used "Tasks and "Time...
It is able to deal with as many 'task' strings you will have in the future.
I commented the code lines, where I thought you do not understand what they do:
Sub CountOccurrencesAndValues()
Dim sh As Worksheet, rngF As Range, arrOcc As Variant, lastRow As Long, lastCol As Long
Dim arr As Variant, arrFin As Variant, countI As Long, valH As Double, j As Long, k As Long, i As Long
Set sh = ActiveSheet
lastRow = sh.Range("F" & Rows.count).End(xlUp).Row
lastCol = sh.UsedRange.Columns.count + 1
Set rngF = sh.Range("F2:F" & lastRow) 'the range where from to extract the unique values
arr = sh.Range("F2:K" & lastRow) 'the array to be processed
'Extract the unique values. Use for that a not used column:
rngF.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=sh.Cells(1, lastCol), Unique:=True
'Put the unique values (sttrings) in an array:
arrOcc = sh.Range(sh.Cells(1, lastCol), sh.Cells(sh.Cells(Rows.count, lastCol).End(xlUp).Row, lastCol)).value
'Clear the temporary used array:
sh.Range(sh.Cells(1, lastCol), sh.Cells(sh.Cells(Rows.count, lastCol).End(xlUp).Row, lastCol)).Clear
ReDim arrFin(1 To UBound(arrOcc, 1), 1 To 3)
k = 1
'Processing the range by iteration:
For i = 1 To UBound(arrOcc, 1)
For j = 1 To UBound(arr, 1)
If arr(j, 1) = arrOcc(i, 1) Then
'count the occurrences and the value
countI = countI + 1: valH = valH + arr(j, 6)
End If
Next j
'put the data in the final array
arrFin(k, 1) = arrOcc(i, 1): arrFin(k, 2) = countI: arrFin(k, 3) = valH
countI = 0: valH = 0: k = k + 1
Next i
'Drop the data from array in the last available column:
'sh.Cells(1, lastCol).value = "Tasks": sh.Cells(1, lastCol + 1).value = "Count": sh.Cells(1, lastCol + 2).value = "Time"
'sh.Cells(2, lastCol).Resize(UBound(arrFin, 1), UBound(arrFin, 2)).value = arrFin
Dim ws As Worksheet
Set ws = Worksheets("Weekly Data")
'Drop the data from array in "Weekly Data" worksheet:
ws.Range("C6").value = "Tasks": ws.Range("D6").value = "Count": ws.Range("E6").value = "Time"
ws.Range("C7").Resize(UBound(arrFin, 1), UBound(arrFin, 2)).value = arrFin
End Sub
I am trying to find the last row the same way I found the last column:
Sheets("Sheet2").Cells(1,Sheets("Sheet2").Columns.Count).End(xlToLeft).Column
I know this way but it is not as helpful as the prior would be:
u = Sheets("Sheet1").Range("A65536").End(xlUp).Row
I tried:
Sheets("Sheet2").Cells(Sheets("Sheet2",1).Rowa.Count).End(xlToUP).Column
Synopsis: I would like the below way for last row.
Sheets("Sheet2").Cells(1,Sheets("Sheet2").Columns.Count).End(xlToLeft).Column
You should use a with statement to qualify both your Rows and Columns counts. This will prevent any errors while working with older pre 2007 and newer 2007 Excel Workbooks.
Last Column
With Sheets("Sheet2")
.Cells(1, .Columns.Count).End(xlToLeft).Column
End With
Last Row
With Sheets("Sheet2")
.Range("A" & .Rows.Count).End(xlUp).Row
End With
Or
With Sheets("Sheet2")
.Cells(.Rows.Count, 1).End(xlUp).Row
End With
How is this?
dim rownum as integer
dim colnum as integer
dim lstrow as integer
dim lstcol as integer
dim r as range
'finds the last row
lastrow = ActiveSheet.UsedRange.Rows.Count
'finds the last column
lastcol = ActiveSheet.UsedRange.Columns.Count
'sets the range
set r = range(cells(rownum,colnum), cells(lstrow,lstcol))
This function should do the trick if you want to specify a particular sheet. I took the solution from user6432984 and modified it to not throw any errors. I am using Excel 2016 so it may not work for older versions:
Function findLastRow(ByVal inputSheet As Worksheet) As Integer
findLastRow = inputSheet.cellS(inputSheet.Rows.Count, 1).End(xlUp).Row
End Function
This is the code to run if you are already working in the sheet you want to find the last row of:
Dim lastRow as Integer
lastRow = cellS(Rows.Count, 1).End(xlUp).Row
I use this routine to find the count of data rows. There is a minimum of overhead required, but by counting using a decreasing scale, even a very large result requires few iterations. For example, a result of 28,395 would only require 2 + 8 + 3 + 9 + 5, or 27 times through the loop, instead of a time-expensive 28,395 times.
Even were we to multiply that by 10 (283,950), the iteration count is the same 27 times.
Dim lWorksheetRecordCountScaler as Long
Dim lWorksheetRecordCount as Long
Const sDataColumn = "A" '<----Set to column that has data in all rows (Code, ID, etc.)
'Count the data records
lWorksheetRecordCountScaler = 100000 'Begin by counting in 100,000-record bites
lWorksheetRecordCount = lWorksheetRecordCountScaler
While lWorksheetRecordCountScaler >= 1
While Sheets("Sheet2").Range(sDataColumn & lWorksheetRecordCount + 2).Formula > " "
lWorksheetRecordCount = lWorksheetRecordCount + lWorksheetRecordCountScaler
Wend
'To the beginning of the previous bite, count 1/10th of the scale from there
lWorksheetRecordCount = lWorksheetRecordCount - lWorksheetRecordCountScaler
lWorksheetRecordCountScaler = lWorksheetRecordCountScaler / 10
Wend
lWorksheetRecordCount = lWorksheetRecordCount + 1 'Final answer
This gives you the last used row in a specified column.
Optionally you can specify the worksheet, otherwise it will take the active sheet.
Function getLastRow(col As Integer, Optional ws As Worksheet) As Long
If ws Is Nothing Then Set ws = ActiveSheet
If ws.Cells(ws.Rows.Count, col).Value <> "" Then
getLastRow = ws.Cells(ws.Rows.Count, col).Row
Exit Function
End If
getLastRow = ws.Cells(Rows.Count, col).End(xlUp).Row
If shtRowCount = 1 Then
If ws.Cells(1, col) = "" Then
getLastRow = 0
Else
getLastRow = 1
End If
End If
End Function
Sub test()
Dim lgLastRow As Long
lgLastRow = getLastRow(2) 'Column B
End Sub
This is the best way I've seen to find the last cell.
MsgBox ActiveSheet.UsedRage.SpecialCells(xlCellTypeLastCell).Row
One of the disadvantages to using this is that it's not always accurate. If you use it then delete the last few rows and use it again, it does not always update. Saving your workbook before using this seems to force it to update though.
Using the next bit of code after updating the table (or refreshing the query that feeds the table) forces everything to update before finding the last row. But, it's been reported that it makes excel crash. Either way, calling this before trying to find the last row will ensure the table has finished updating first.
Application.CalculateUntilAsyncQueriesDone
Another way to get the last row for any given column, if you don't mind the overhead.
Function GetLastRow(col, row)
' col and row are where we will start.
' We will find the last row for the given column.
Do Until ActiveSheet.Cells(row, col) = ""
row = row + 1
Loop
GetLastRow = row
End Function
Problems with normal methods
Account for Blank Rows / Columns -
If you have blank rows or columns at the beginning of your data then methods like UsedRange.Rows.Count and UsedRange.Columns.Count will skip over these blank rows (although they do account for any blank rows / columns that might break up the data), so if you refer to ThisWorkbook.Sheets(1).UsedRange.Rows.Count you will skip lines in cases where there are blank rows at the top of your sheet, for example on this sheet:
This will skip the top row from the count and return 11:
ThisWorkbook.Sheets(1).UsedRange.Rows.Count
This code will include the blank row and return 12 instead:
ThisWorkbook.Sheets(1).UsedRange.Cells(ThisWorkbook.Sheets(1).UsedRange.Rows.Count, 1).Row
The same issue applies to columns.
Full Sheets -
Identifying the last row or column can be difficult if your sheet is full (this only matters if either your data contains over a million lines or might have values in the final rows or columns of your data). For example, if you use xlEndUp or similar and the cell you're referring to is populated then the code will skip over data, in extreme cases your entire data set can be skipped if for example the data continues from the last row of the sheet (where you start your xlEndUp) solidly up to the first row (in this case the result would be 1).
'This code works, but...
'Will not function as intended if there is data in the cell you start with (Cell A:1048576).
Dim Sht1 as Range: Set Sht1 = ThisWorkbook.Sheets(1)
Sht1.Cells(Sht1.Rows.Count, 1).End(xlUp).Row
Columns with blank rows -
The above code also assumes that your data extends the entire way down column 1, if you have blank entries in column 1 you may lose rows as the code will find the first filled row from the bottom only for column 1.
Unnecessary Looping -
Self explanatory, best to avoid looping where possible as if you're dealing with a lot of data and repeating the looping process often it can slow down your code.
Solution
Note that this is targeted at finding the last "Used" Row or Column on an entire sheet, this doesn't work if you just want the last cell in a specific range.
I've setup some Functions here
Private Function GetLastRow(Sheet As Worksheet)
'Gets last used row # on sheet.
GetLastRow = Sheet.UsedRange.Cells(Sheet.UsedRange.Rows.Count, 1).Row
End Function
Private Function GetLastCol(Sheet As Worksheet)
'Gets last used column # on sheet.
GetLastCol = Sheet.UsedRange.Cells(1, Sheet.UsedRange.Columns.Count).Column
End Function
Examples of calling these Functions:
Sub CallFunctions()
'Define the Target Worksheet we're interested in:
Dim Sht1 As Worksheet: Set Sht1 = ThisWorkbook.Sheets(1)
'Print the last row and column numbers:
Debug.Print "Last Row = "; GetLastRow(Sht1)
Debug.Print "Last Col = "; GetLastCol(Sht1)
End Sub
I preferred search last blank cell:
Il you want last empty cell of column you can do that
Dim sh as Worksheet, r as range
set sh = ActiveWorksheet 'if you want an other it's possible
'find a value
'Columns("A:D") 'to check on multiple columns
Set r = sh.Columns("A").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
'no value return first row
If r Is Nothing Then Set r = sh.Cells(1, "A") Else Set r = sh1.Cells(r.Row + 1, "A")
If this is to insert new row, find on multiple columns is a good choice because first column can contains less rows than next columns
I use the following function extensively. As pointed out above, using other methods can sometimes give inaccurate results due to used range updates, gaps in the data, or different columns having different row counts.
Example of use:
lastRow=FindRange("Sheet1","A1:A1000")
would return the last occupied row number of the entire range. You can specify any range you want from single columns to random rows, eg FindRange("Sheet1","A100:A150")
Public Function FindRange(inSheet As String, inRange As String) As Long
Set fr = ThisWorkbook.Sheets(inSheet).Range(inRange).find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
If Not fr Is Nothing Then FindRange = fr.row Else FindRange = 0
End Function
I have a sheet with 32 columns of data, starting in row 2 to LastRow. The first row is a header row. Several columns contain hyperlink formulas (“D”,”F”,”R”,”S”,”X”,”Z” and “AA”), other columns contain general values. I would like to populate an array with rows that don’t include specific values in column D. Those values are part of a hyperlink formula. For example, in D3 there is =HYPERLINK("http://www.uniprot.org/uniprot/P35222"," CTNNB1"), I’m filtering based on the values inside the second set of quotation marks “CTNNB1”. I would like to output this array on a new sheet. The code bellow runs but it doesn’t output any data. The code includes comments to explain steps and issues. Please help me fix the code or suggest something that will work. Thank you very much in advance.
Once the rows that meet the criteria are identified, how do I create an array row by row and how to correctly output it on a Sheet “Access”?
Sub aa()
Dim CellValue As Variant
Dim CellFormula As String
Dim CellPart() As String
Dim CellValueRow As Long
Dim CellValueCol As Long
Dim ColCrnt As Long
Dim ColLast As Long
Dim RowCrnt As Long
Dim RowLast As Long
With Worksheets("all") ' Replaced with name of your worksheet
RowLast = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByRows, xlPrevious).Row
ColLast = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByColumns, xlPrevious).Column
ReDim CellValue(1 To RowLast - 1, 1 To ColLast) 'max # of array rows based on last row of data available
CellValueRow = 1
For RowCrnt = 2 To RowLast
CellFormula = .Cells(RowCrnt, "D").Formula
If Left(CellFormula, 11) = "=HYPERLINK(" Then
CellFormula = Mid(CellFormula, 12) '=> "http://www.uniprot.org/uniprot/P42336","PIK3CA")
CellFormula = Mid(CellFormula, 1, Len(CellFormula) - 1) '=> "http://www.uniprot.org/uniprot/P42336","PIK3CA"
CellFormula = Replace(CellFormula, """", "") '=> http://www.uniprot.org/uniprot/P42336,PIK3CA
CellPart = Split(CellFormula, ",")
'Debug.Print CellPart(0) & " " & CellPart(1)
If CellPart(1) <> "Q61R" And CellPart(1) <> "I391M" And CellPart(1) <> "V600E" And _
CellPart(1) <> "PIC3CA" And CellPart(1) <> "BRAF" And CellPart(1) <> "EGFR" Then
CellValue(CellValueRow, ) = .Range(.Cells(RowCrnt, 1), .Cells(RowCrnt, ColLast)).Formula '===> need help here
CellValueRow = CellValueRow + 1
End If
End If
Next
'For RowCrnt = 1 To 10
'For ColCrnt = 1 To 10
'Debug.Print "[R" & RowCrnt & "C" & ColCrnt & "]" & CellValue(RowCrnt, ColCrnt);
'Next
'Debug.Print
'Next
End With
Worksheets("Access").Range("A2:AF" & RowLast).Value = Application.Index(CellValue, 0)
End Sub
Issue 1
Dim i, j, k, m, LastRow, openPos, closePos As Integer 'As Long
This declares i, j, k to openPos as Variants and only closePos as an Integer, If you list several variables in one Dim statement, you must give each one its own type.
Do not use type Integer. With VBA, “Integer” declares a 16-bit integer which requires special processing on 32-bit or 64-bit computers. Long is now the recommended type.
I rarely place several variables in a single Dim statement. It saves a little typing but I prefer to declare my variables one per line in alphabetic sequence.
Please do not declare variables with names like i, j and k. If this is a “quick write” macro that will then be discarded, names probably do not matter too much. However, if you might return to this macro in six months, will you remember what i, j and k are? Meaningful names take longer to type but make your code so much easier to read and understand.
Issue 2
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
The active worksheet is the default worksheet so specifying its use does not serve much purpose.
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
would give exactly the same effect.
However I would prefer you write With Worksheets(“xxxx”). If you use the active worksheet, you are relying on the user having the required worksheet open when they start the macro. If you return to this macro in six months, will you remember which worksheet is the required worksheet? Sheets.Add makes the new sheet the active worksheet. Your code can get very confusing if you have to remember which sheet is the active sheet.
Issue 3
ReDim Result(LastRow - 1)
The format for subscripts is: [Lower To] Upper.
If you omit “[Lower To]”, the value of the Option Base statement determines the value of the lower bound. I do not recall ever seeing the Option Base statement but I still prefer being explicit. VBA is unusual in allowing you to have different lower bounds; for most languages it is fixed as zero. With VBA I can write: ReDim Result(2 To LastRow). I always set my lower bounds to what every value I find most helpful at the time.
If VBA creates an array (for example with Split), that array will almost always have a lower bound of zero. The only exception I can think of is when you copy a range to a Variant. Here the resultant array has lower bounds of one.
You set Result to one dimension but use it as two dimensional array. I think you want:
ReDim Result(1 To LastRow-1, 1 To 27)
Issue 4
On Error Resume Next
You should only use this statement like this:
On Error Resume Next
Statement that might fail
On Error GoTo 0
If Err.Number > 0 Then
Test or display Err.Number or Err.Description
End If
You should only use On Error when you cannot avoid Excel encountering an error. For example, when opening a file for which you might not have read permission. In this situation, On Error allows you to provide the user with a helpful message or perhaps recover by trying a different file. You do not use it to avoid arithmetic errors.
Issue 5
If Application.ReferenceStyle = xlR1C1 Then
Str = .Cells(i, 4).FormulaR1C1
Else
Str = .Cells(i, 4).Formula
End If
Application.ReferenceStyle affects how formulae are displayed. A VBA macro can request either style. Pick the formula style you prefer although a hyperlink should not be affected by your choice.
Issue 6
Before you can extract the display text from a hyperlink formula you must check the cell contains a hyperlink formula. This macro uses a different technique although there is nothing wrong with searching for the last two double quotes in the formula. With this technique, the value you seek is in CellPart(1).
Option Explicit
Sub Demo()
Dim CellFormula As String
Dim CellPart() As String
Dim RowCrnt As Long
Dim RowLast As Long
With Worksheets("Data") ‘ Replace with the name of your worksheet
RowLast = .Cells(Rows.Count, "D").End(xlUp).Row
For RowCrnt = 2 To RowLast
CellFormula = .Cells(RowCrnt, "D").Formula
If Left(CellFormula, 11) = "=HYPERLINK(" Then
' It is possible to make all these changes to CellFormula in one go
' but this is better for showing what I am doing
CellFormula = Mid(CellFormula, 12)
CellFormula = Mid(CellFormula, 1, Len(CellFormula) - 1)
CellFormula = Replace(CellFormula, """", "")
CellPart = Split(CellFormula, ",")
Debug.Print CellPart(0) & " " & CellPart(1)
End If
Next
End With
End Sub
**Issue 7 **
In your macro you are:
Scanning down column D looking for rows of interest.
Copying the cells of rows of interest to an array.
You do nothing with the final array but I assume you intended to write it to the new worksheet.
This technique involves moving every cell of interest individually from the worksheet to the array. This is not quite as slow as some people think but it is not in my view the easiest approach.
You have used LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row to find the last row containing data. VBA offers several methods of finding the last row and column and this is generally the easiest to use. However, none of the available methods works in every situation. This technique relies on the programmer knowing which column (or row) contains the most data.
I have used:
RowLast = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByRows, xlPrevious).Row
ColLast = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByColumns, xlPrevious).Column
The first statement finds the last used cell in any column while the second finds the last used cell in any row. These statements do not rely on the programmer knowing which column has the last row or which row has the last column. They are also useful if your data is not rectangular.
In this macro, I have pulled every formula from every cell in the worksheet into an array in a single statement. I have then displayed the first ten rows and columns so you can see what I have imported.
Sub Demo2()
Dim CellValue As Variant
Dim ColCrnt As Long
Dim ColLast As Long
Dim RowCrnt As Long
Dim RowLast As Long
With Worksheets("Data") ' Replace with the name of your worksheet
RowLast = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByRows, xlPrevious).Row
ColLast = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByColumns, xlPrevious).Column
CellValue = .Range(.Cells(1, 1), .Cells(RowLast, ColLast)).Formula
For RowCrnt = 1 To 10
For ColCrnt = 1 To 10
Debug.Print "[R" & RowCrnt & "C" & ColCrnt & "]" & CellValue(RowCrnt, ColCrnt);
Next
Debug.Print
Next
End With
End Sub
You may need to increase my end values of 10 to see enough data but this macro demonstrates that I can download every value and formula in a worksheet into an array with a single statement.
I recommend creating little macros like mine that explore a single feature when you are unsure about that feature. The trouble with your complete macro is that you do not know where it has gone wrong. With a single feature macro there is nothing else to confuse the picture as you try different things you get it working. If you fail to get it working, a single feature macro will get an answer on Stack Overflow much more quickly than a confused, multi-feature macro.
Complete solution
Above I have explored how to access the data and how to make decisions about which rows are of interest. I think we are now ready to make final decisions.
There are several approaches and it is not obvious to me which would be the better.
For step 1, I believe importing the worksheet into an array and identifying interesting rows in memory is the best approach. The alternative, reading down column D within the worksheet, has no advantages that I can see.
For step 2, I can see three different approaches with a minor different to step 1:
Copy the entire worksheet to an array. Copy interesting rows to a different array. Copy the second array to a new worksheet.
Copy column D of the worksheet to an array. Use the array to identify interesting rows. Copy the interesting rows, as they are identified, from the original worksheet to a new worksheet.
Copy column D of the worksheet to an array. Use the array to identify interesting rows. Use Union to a single range containing all the interesting rows and copy them as a unit from the original worksheet to a new worksheet.
I have never tried approach 3 although I have done something similar by using AutoFilter to select rows and then copying the visible rows to a new location. However, I do not see that it offers anything over approach 2 and I have had problems with very large unions so I have ignored approach 3.
You can only copy values and formulae to an array so you will lose any formatting with approach 1. Approach 1 is probably faster than approach 2. Approach 2 looks as though it will be a little simpler to code.
Apart from the possible need to preserve formatting, I cannot see a major advantage for either approach. Since formatting might be important for this or a similar project, I have decided to go for approach 2.
It is not relevant for approach 2, but you say you do not know how to ReDim Preserve Result to remove the unused rows. The answer is you cannot remove these rows conveniently but it does not matter. You can only use ReDim Preserve to change the size of the last dimension of an array. An array read from a worksheet or being prepared for writing to a worksheet has the worksheet columns as the second dimension. You could use the worksheet function Transpose to switch the dimensions, ReDim the array and then Transpose back. However, I have found that some (perhaps all) worksheet functions are very slow. A transpose coded in VBA is faster than the Excel version. The worksheet functions seem perfectly adequate when called from the keyboard, so the slowness is probably an overhead of the interface. However, when writing an array to a worksheet, unused trailing rows do not matter except possibly if they might overwrite rows you wish to keep.
The following is my attempt at your macro. I do not have much suitable test data but it appears to work as required.
Sub NewAa()
' Change these names as required
Const WshtSrcName As String = "Data"
Const WshtExtName As String = "Extract"
Dim CellFormula As String
Dim CellPart() As String
Dim CellValue As Variant
Dim Found As Boolean
Dim InxNTBE
Dim NotToBeExtracted() As Variant
Dim RowExtCrnt As Long
Dim RowSrcCrnt As Long
Dim RowSrcLast As Long
Dim WshtSrc As Worksheet
Dim WshtExt As Worksheet
' If you are going to be extracting different hyperlinks, an array is easier
' to amend than an If statement
NotToBeExtracted = Array("Q61R", "I391M", "V600E", "PIC3CA", "BRAF", "EGFR")
Set WshtSrc = Worksheets(WshtSrcName)
Worksheets.Add After:=Worksheets(Worksheets.Count)
' The new worksheet is now the active worksheet
ActiveSheet.Name = WshtExtName
Set WshtExt = ActiveSheet
With WshtSrc
RowSrcLast = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByRows, xlPrevious).Row
' Import column D
CellValue = .Range(.Cells(1, "D"), .Cells(RowSrcLast, "D")).Formula
' CellValue will be an array with dimensions (1 To RowLast, 1 to 1).
' Note the lower bounds for such arrays are always one even when column 4 has been imported.
End With
' Copy header row
WshtSrc.Rows(1).Copy Destination:=WshtExt.Cells(1, 1)
' Note the format of copy range is: Xxxxx.Copy Destination:=Yyyyy
' where:
' Xxxxx is the range to be copied
' Yyyyy is the top left cell of the destination range
' "Destination:=" is optional but think it add clarity.
RowExtCrnt = 2
For RowSrcCrnt = 2 To RowSrcLast
CellFormula = CellValue(RowSrcCrnt, 1)
If Left(CellFormula, 11) = "=HYPERLINK(" Then
' Format is: =HYPERLINK("Xxxx","Yyyy")
' Extract Yyyy to CellPart(1)
CellFormula = Mid(CellFormula, 12)
CellFormula = Mid(CellFormula, 1, Len(CellFormula) - 1)
CellFormula = Replace(CellFormula, """", "")
CellPart = Split(CellFormula, ",")
' Attempt to match CellFormula against one of the hyperlink texts
' that are not to be extracted
Found = False
For InxNTBE = LBound(NotToBeExtracted) To UBound(NotToBeExtracted)
If CellPart(1) = NotToBeExtracted(InxNTBE) Then
Found = True
Exit For
End If
Next
If Not Found Then
' This hyperlink is to be extarcted
WshtSrc.Rows(RowSrcCrnt).Copy Destination:=WshtExt.Cells(RowExtCrnt, 1)
RowExtCrnt = RowExtCrnt + 1
End If
End If
Next
End Sub
I was hoping someone would have some insight as to how to approach the following Excel macro requirement.
Starting condition:
Variable number of text values in Column A.
Proposed solution:
I would like to be able to select a variable number of consecutive cells in column A, and then have the text concatenated, separated by a comma and , into a single column adjacent to the top most cell in column B.
Examples:
A2-A4 would be selected on the sheet.
After running the macro, the contents of B2 (Directly adjacent to top of selection) would contain text in the form "A2, A3, A4".
A5-A10 selected:
After running the macro, the contents of B5 (Directly adjacent to top of selection) would contain text in the form "A5, A6, A7, A8, A9, A10".
What is killing me is how to utilize the variablity of multiple selections and additonally, I'm not clear on how to handle looping in Excel macro's. I have a CS degree but I ended up working in Infrastructure so I'm a bit rusty. Is someone could help, this would save me emmense time everyday. Thanks to any responses.
The following code does what you seek. I have not added many comments because I am not sure what level of comments are appropriate. For example, I do not want to explain the purpose of each statement if your CS degree allows you to guess. I also suspect there is more to your question than the obvious. For example, should I have made this a function with the worksheet and row numbers passed as parameters. Please come back with questions and I will improve my answer as necessary.
Option Explicit
Sub JoinCells()
Dim ColFirst As Long
Dim ColLast As Long
Dim JoinedValue As String
Dim RowCrnt As Long
Dim RowFirst As Long
Dim RowLast As Long
RowFirst = Selection.Row ' First row of selection
' Selection.Rows.Count returns the number of rows in the selection.
' Warning! You can fool this code by making multiple selections.
RowLast = RowFirst + Selection.Rows.Count - 1
ColFirst = Selection.Column
ColLast = ColFirst + Selection.Columns.Count - 1
If ColFirst <> 1 Or ColLast <> 1 Then
Call MsgBox("Please select a range within column ""A""", vbOKOnly)
Exit Sub
End If
With Worksheets("xxxxxxx") ' Worksheet of your choice.
JoinedValue = .Cells(RowFirst, "A").Value
For RowCrnt = RowFirst + 1 To RowLast
JoinedValue = JoinedValue & "," & .Cells(RowCrnt, "A").Value
Next
.Cells(RowFirst, "B").Value = JoinedValue
End With
End Sub