Using Range.Find in VBA to find only the previous value x? - excel

I am trying to use the Range.Find method in VBA to locate the closest previous row number that has a "true" value.
For example, in Column X, there will be a "true" value (row 35), 10 rows with "false," and then "true" again (row 46).
When I get to row 46 in my loop, I need to do a range.find and return row 35.
The code I am using is this:
Worksheets("Data").Cells.Find(True, searchorder:=xlByColumns, searchdirection:=xlNext).Row
What is happening is that I am only finding either the very first "true" value (in this case, row 2), or the very last "true" value (row 24,xxx), as I vary search direction.
What can I do to find only the previous-most "true" value?

You can find the previous row with True by using the After argument in the Find method combined with xlPrevious as the SearchDirection. I have updated the code to add it into a loop, based on your comments.
Since you posted your code, I have edited my answer into your code.
Sub Main()
Dim iCurRow As Long
Dim iCounter As Long
Dim iLastRow As Long
Dim iTempRow As Long
Dim iPreviousRow As Long
Dim iChangeCol As Long
Dim ws As Worksheet
Set ws = Worksheets("Data")
With ws
iChangeCol = .Cells.Find(what:="Change Over?", searchorder:=xlByColumns, searchdirection:=xlNext).Column
iLastRow = .Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
iPreviousRow = 2
For iCounter = 3 To iLastRow
If .Cells(iCounter, iChangeCol).Value = True Then
iTempRow = .Cells.Find(what:=True, After:=.Cells(iCounter, iChangeCol), searchorder:=xlByColumns, searchdirection:=xlPrevious).Row
iPreviousRow = iTempRow
End If
Next iCounter
End With
End Sub

This short snippet uses both the Range.Find method and Range.FindNext method to cycle through all matching cells in column X.
Sub rings_true()
Dim fnd As Range
With Worksheets("Sheet1") `<~~ set this worksheet reference properly
With .Columns(24)
Set fnd = .Find(What:="TRUE", after:=.Cells(.Rows.Count), _
LookIn:=xlValues, LookAt:=xlWhole, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
Do While Not fnd Is Nothing
If MsgBox("Currently at " & fnd.Address(0, 0) & Chr(10) & "exit now...?", vbYesNo + vbQuestion) = vbYes Then
Exit Do
Else
Set fnd = .FindNext(after:=fnd)
End If
Loop
End With
End With
End Sub
The current cell address is reported through a MsgBox function. The same MsgBox offers the user the opportunity to break the loop.
Additional error control might include confirming at least one matching value in column X before entering into the loop.

There are multiple arguments to put into the Find method, regarding what you told us, I suggest that you use :
After:=.Cells(.Rows.Count, 1) to start from the bottom of the column
LookIn:=xlValues
LookAt:=xlWhole
SearchOrder:=xlByRows to look row by row (instead of column by column)
SearchDirection:=xlPrevious to look "back", from bottom to top
MatchCase:=False
SearchFormat:=False
And furthermore, you can use the .Find method into a specific range, so rather than Worksheets("Data").Cells.Find(..., you should use Worksheets("Data").Range("X:X").Find(... to look only in the column X.
Here is your amended code :
Sub test_ilarson007()
Dim FirstAddress As String, PreviousMatch As Range, cF As Range
Worksheets("Data").Activate
With Worksheets("Data").Range("X:X")
'First, define properly the Find method
Set cF = .Find(What:=True, _
After:=ActiveCell, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False, _
SearchFormat:=False)
'If there is a result,
If Not cF Is Nothing Then
FirstAddress = cF.Address
MsgBox "The row containing the previous 'True' in Column X is : " & cF.Row
'keep looking with FindNext method : Not usefull for your example
Do
Set PreviousMatch = cF
Set cF = .FindNext(cF)
'-------------------------------------------------------------
'----Place instructions to execute on the matched cell/row/...
'First match (i.e. Row 46 in your example)
MsgBox PreviousMatch.Row 'Should display 46 (then 35, then ??)
'Second match (i.e. Row 35 in your example)
MsgBox cf.Row 'Should display 35 (then ??, then ??)
'-------------------------------------------------------------
'Look until you find again the first result
Loop While Not cF Is Nothing And cF.Address <> FirstAddress
End If
End With
End Sub

Related

Merge 2 columns and find text VBA

I have one table and one file. I can find the text which is in specific place in file inside the table.
However, the texts are not unique all the time, so I decided to combine 2 cells in file and try to find in table. unless, I cannot find a way to combine 2 columns in table to match it with combined 2 cells in file.
Below you may see example table.
my aim is adding date in cell next cell of Units. So I try to find A1234 instead of 1234 due to 1234 not unique.
FindString = wb.Sheets("1").Range("E4").Value & wb.Sheets("1").Range("E5").Value
If Trim(FindString) <> "" Then
With Wb2.Sheets("Sheet1").Range("A:A") 'this section need to be amended and need combine column A&B
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
Rng.Offset(0, 1).Value = wb.Sheets("1").Range("I4") ' if column A&B combining completed then next cell probably will not work
Else
MsgBox "Nothing found in the list"
End If
This is similar to the variant strategy mentioned in the comments-- Try looping through your data with a For loop and an If Statement looking for both values to match. Here's an example code that shows the concept
Sub test()
Dim s As Worksheet, findstring1 As String, findstring2 As String
Dim firstrow As Integer, lastrow As Integer, i As Integer
Set s = Sheets("test")
findstring1 = "A "'replace this with the Customer reference (what to search for)
findstring2 = "1234" 'replace this with the unit reference
firstrow = 2 ' row number for first cell with data
lastcell = s.Cells(2, 1).End(xlDown).Row 'find last cell row number (end of data)
For i = firstrow To lastcell
If s.Cells(i, 1) = findstring1 And s.Cells(i, 2) = findstring2 Then
'do something with found values
End If
Next i
End Sub

VBA Trying to check for a value in column and if there copy another cells value to a new column

I have a table of data in a sheet that i am looking to make some adjustments to. I have a single column called "S/R" which will have one of two values in it [Serving OR Returning]. If the value is serving i want to copy the value from a column called "1stServeX" to a new column i have added i called "Server 1st Serve X".
I have written the code below but am beginning to trip myself up and also cannot finish the last part. I am a novice and so have been using other pieces of code i have gained previously to try and piece it together, which is why i need some help.
If i can get this going then i can simply repeat it for all the "Returner" option and all the other columns i need to split too.
Thanks in advance for any help offered.
Public Sub splitServerCoordinates()
'Set a constant for the title of the Server Column
Const HEADER_SR As String = "S/R"
Dim ws As Worksheet
Set ws = Sheets("transition")
Dim strSearch As String
Dim aCell As Range
Dim COL_SR As Long
Dim COL_TARGET As Long
Dim COL_CURRENT As Long
'Find the Column Numbers of the columns we are looking for
strSearch = "S/R"
Set aCell = ws.Rows(1).Find(What:=strSearch, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
COL_SR = aCell.Column
End If
strSearch = "1stServeX"
Set aCell = ws.Rows(1).Find(What:=strSearch, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
COL_CURRENT = aCell.Column
End If
strSearch = "Server 1st Serve X"
Set aCell = ws.Rows(1).Find(What:=strSearch, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
COL_TARGET = aCell.Column
End If
Dim theUsedRange As Range
Dim SRRange As Range
Dim aPlayer As Range
Dim serving As String
Dim returning As String
Dim theCounter As Long
Dim theSequence As Long
ws.Select
' clear out the Target column and add the header again
Set theUsedRange = ActiveSheet.UsedRange
Intersect(theUsedRange, Range(Columns(COL_TARGET), Columns(COL_TARGET))).ClearContents
Columns(COL_SR).Range("A1").Value = HEADER_SR
' reset the used range just in case
Set theUsedRange = ActiveSheet.UsedRange
' Get the used range for the S/R column
Set SRRange = Intersect(theUsedRange, Columns(COL_SR))
'Set value to compare to
serving = "Serving"
' Loop through the S/R column
For Each aPlayer In SRRange
' ignore the header row
If aPlayer <> HEADER_SR Then
' if we are serving then copy the value from COL_CURRENT to COL_TARGET
If aPlayer = serving Then
aPlayer.Offset(-1, COL_TARGET - COL_).Value = STUCK - HERE
End If
End If
Next aPlayer
End Sub
Some refactoring to pull out the column header location parts, and a few other tweaks. Untested, but should get you there.
Public Sub splitServerCoordinates()
Dim ws As Worksheet, c As Range
Dim COL_SR As Long
Dim COL_TARGET As Long
Dim COL_CURRENT As Long
Set ws = Sheets("transition")
'Find the Column Numbers of the columns we are looking for
COL_SR = HeaderColumnNumber(ws.Rows(1), "S/R")
COL_CURRENT = HeaderColumnNumber(ws.Rows(1), "1stServeX")
COL_TARGET = HeaderColumnNumber(ws.Rows(1), "Server 1st Serve X", True) 'add if not found
'exit if missing any required columns
If COL_SR = 0 Or COL_CURRENT = 0 Then
MsgBox "Missing 'S/R' and/or '1stServeX' !"
Exit Sub
End If
'reset target column
ws.Columns(COL_TARGET).ClearContents
ws.Cells(1, COL_TARGET).Value = "Server 1st Serve X"
'loop rows
For Each c In ws.Range(ws.Cells(2, COL_SR), ws.Cells(ws.Rows.Count, COL_SR).End(xlUp)).Cells
If c.Value = "Serving" Then
ws.Cells(c.Row, COL_TARGET).Value = ws.Cells(c.Row, COL_CURRENT).Value
End If
Next c
End Sub
'Find a header position on a row, with option to add it if not found
' Returns zero if header is not found and option to add was not set
Function HeaderColumnNumber(rng As Range, hdr As String, _
Optional AddIfMissing As Boolean = False) As Long
Dim f As Range
Set rng = rng.Cells(1).EntireRow 'only want a full row to look in
Set f = rng.Find(What:=hdr, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not f Is Nothing Then
HeaderColumnNumber = f.Column 'found: return column
Else
'not found: do we add it, or return zero?
If AddIfMissing Then
With rng.Cells(rng.Cells.Count).End(xlToLeft).Offset(0, 1)
.Value = hdr
HeaderColumnNumber = .Column
End With
Else
HeaderColumnNumber = 0
End If
End If
End Function

VBA: Search and select last found string in a column containing duplicate entries

I am trying to search a column that has duplicate entries of information. I want to select the last found occurence of the string in the column. How can I do this?
If possible, please show me how this can be done with the Selection.Find method.
Columns("A:A").Select
Selection.Find(What:="foobar", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Sub FindAndSelectAll()
Dim str As String, cll As Range, c As Range
Dim rSearch As Range
Set rSearch = Range("A1").CurrentRegion
With rSearch
For Each cll In rSearch
Set c = .Find(cll.Value2, _
LookIn:=xlValues, _
searchdirection:=xlPrevious)
If Not c Is Nothing And cll.Row < c.Row Then
Range(c.Address).Interior.Color = 65535
End If
Next
End With
End Sub
I found the answer I was looking for. By setting the SearchDirection property to xlPrevious, it will find the last value in the range. Then the cell can be focused on by using the .Select method. However, if the value that is being searched is a substring of other values within the column, it may select the wrong cell. This is solved by using a while loop that checks the value of the cell it finds, and keeps searching the previous value if it is not the string we are looking for.
Sub FindLast()
Dim fc As Range
Dim my_var As String
Dim cell_check As Variant
my_var = "String 1"
Set fc = Worksheets("Sheet1").Columns("A").Find(what:=my_var, _
SearchDirection:=xlPrevious)
fc.Select
cell_check = ActiveCell.Value
While cell_check <> my_var
Set fc = Worksheets("Sheet1").Columns("A").FindPrevious(after:=fc)
fc.Select
cell_check = ActiveCell.Value
Wend
End Sub
I found the solution by reading the documentation on Microsofts website.
https://learn.microsoft.com/en-us/office/vba/api/excel.range.findprevious

Excel / VBA - How to select the top row (absolute) of whichever column (relative) the currently selected cell is in?

I spent 11 hours a few days ago ripping my brain apart to do this. Everyone either answers using sample ranges with absolute values, or with the entirely relative .offset function. Or they mention it's not good to select in vba, or they provide a workaround of some sort that I can't adapt, or .select doesn't work with R1C1...etc, etc. My script is done now, and fully functioning with the following loop code, but it's SLOW because it uses this loop about 2000-3000 times each time the macro runs:
Do Until Selection.Row = 1
If Selection.Row <> 1 Then
Selection.Offset(-1, 0).Select
End If
Loop
I just want to know, for whichever cell is currently selected, wherever it is, is there a faster way in vba to .Select the top row (row #1, absolute reference) of that (any) column (relative reference)?
For do it faster you can optimize like this:
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Do Until Selection.Row = 1
If Selection.Row <> 1 Then
Selection.Offset(-1, 0).Select
End If
Loop
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
One question, you can not use Cells(x,y).row instead of Selection metod ? This is a faster way.
In other way, the column normaly have a name in top, you can search this name and get this position an select the row below.
Something like this:
Private Sub CommandButton1_Click()
Dim intColumn As Integer
intColumn = ObtainColumn(Range("A1:F1"), "NameColum")
intRow = ObtainRow(Range("A1:A10"), "NameColum")
Cells(intRow, intColumn).Select
End Sub
Function ObtainColumn(rng As Range, strValue As String) As Long
Dim lCol As Long
'Set rng = ActiveSheet.Cells
On Error Resume Next
lCol = 0
lCol = rng.Find(What:=strValue, _
After:=rng.Cells(1), _
LookAt:=xlWhole, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
ObtainColumn = lCol
On Error GoTo 0
End Function
Function ObtainRow(rng As Range, strValue As String) As Long
Dim lRow As Long
'Set rng = ActiveSheet.Cells
lRow = 0
On Error Resume Next
lRow = rng.Find(What:=strValue, _
After:=rng.Cells(1), _
LookAt:=xlWhole, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
ObtainRow = lRow
On Error GoTo 0
On Error GoTo 0
End Function
There is no need to iterate to find the top of the current column:
Selection.End(xlUp).Activate
The .End(xlUp) member of a Range finds the end of the contiguous data set. More info here.
or
Cells(1, Selection.Column).Activate
This method uses the Column member of a Range to return the number of that column, then uses the Cells function to call the first row of that column. More info here.
or (as mentioned)
Selection.Offset(1 - Selection.Row).Select
This method uses the Offset member of a Range. This function (more info here) has two optional parameters. The first is RowOffset, so this formula will offset a cell in A21 by -20 rows, thus giving A1.
Edited for more information and references

Getting the actual usedrange

I have a Excel worksheet that has a button.
When I call the usedRange() function, the range it returns includes the button part.
Is there anyway I can just get actual used range that contains data?
What sort of button, neither a Forms Control nor an ActiveX control should affect the used range.
It is a known problem that excel does not keep track of the used range very well. Any reference to the used range via VBA will reset the value to the current used range. So try running this sub procedure:
Sub ResetUsedRng()
Application.ActiveSheet.UsedRange
End Sub
Failing that you may well have some formatting hanging round. Try clearing/deleting all the cells after your last row.
Regarding the above also see:
Excel Developer Tip
Another method to find the last used cell:
Dim rLastCell As Range
Set rLastCell = ActiveSheet.Cells.Find(What:="*", After:=.Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)
Change the search direction to find the first used cell.
Readify made a very complete answer. Yet, I wanted to add the End statement, you can use:
Find the last used cell, before a blank in a Column:
Sub LastCellBeforeBlankInColumn()
Range("A1").End(xldown).Select
End Sub
Find the very last used cell in a Column:
Sub LastCellInColumn()
Range("A" & Rows.Count).End(xlup).Select
End Sub
Find the last cell, before a blank in a Row:
Sub LastCellBeforeBlankInRow()
Range("A1").End(xlToRight).Select
End Sub
Find the very last used cell in a Row:
Sub LastCellInRow()
Range("IV1").End(xlToLeft).Select
End Sub
See here for more information (and the explanation why xlCellTypeLastCell is not very reliable).
Here's a pair of functions to return the last row and col of a worksheet, based on Reafidy's solution above.
Function LastRow(ws As Object) As Long
Dim rLastCell As Object
On Error GoTo ErrHan
Set rLastCell = ws.Cells.Find("*", ws.Cells(1, 1), , , xlByRows, _
xlPrevious)
LastRow = rLastCell.Row
ErrExit:
Exit Function
ErrHan:
MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbExclamation, "LastRow()"
Resume ErrExit
End Function
Function LastCol(ws As Object) As Long
Dim rLastCell As Object
On Error GoTo ErrHan
Set rLastCell = ws.Cells.Find("*", ws.Cells(1, 1), , , xlByColumns, _
xlPrevious)
LastCol = rLastCell.Column
ErrExit:
Exit Function
ErrHan:
MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbExclamation, "LastRow()"
Resume ErrExit
End Function
Public Sub FindTrueUsedRange(RowLast As Long, ColLast As Long)
Application.EnableEvents = False
Application.ScreenUpdating = False
RowLast = 0
ColLast = 0
ActiveSheet.UsedRange.Select
Cells(1, 1).Activate
Selection.End(xlDown).Select
Selection.End(xlDown).Select
On Error GoTo -1: On Error GoTo Quit
Cells.Find(What:="*", LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Activate
On Error GoTo -1: On Error GoTo 0
RowLast = Selection.Row
Cells(1, 1).Activate
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Cells.Find(What:="*", LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Activate
ColLast = Selection.Column
Quit:
Application.ScreenUpdating = True
Application.EnableEvents = True
On Error GoTo -1: On Error GoTo 0
End Sub
This function returns the actual used range to the lower right limit. It returns "Nothing" if the sheet is empty.
'2020-01-26
Function fUsedRange() As Range
Dim lngLastRow As Long
Dim lngLastCol As Long
Dim rngLastCell As Range
On Error Resume Next
Set rngLastCell = ActiveSheet.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious)
If rngLastCell Is Nothing Then 'look for data backwards in rows
Set fUsedRange = Nothing
Exit Function
Else
lngLastRow = rngLastCell.Row
End If
Set rngLastCell = ActiveSheet.Cells.Find("*", searchorder:=xlByColumns, searchdirection:=xlPrevious)
If rngLastCell Is Nothing Then 'look for data backwards in columns
Set fUsedRange = Nothing
Exit Function
Else
lngLastCol = rngLastCell.Column
End If
Set fUsedRange = ActiveSheet.Range(Cells(1, 1), Cells(lngLastRow, lngLastCol)) 'set up range
End Function
I use the following vba code to determine the entire used rows range for the worksheet to then shorten the selected range of a column:
Set rUsedRowRange = Selection.Worksheet.UsedRange.Columns( _
Selection.Column - Selection.Worksheet.UsedRange.Column + 1)
Also works the other way around:
Set rUsedColumnRange = Selection.Worksheet.UsedRange.Rows( _
Selection.Row - Selection.Worksheet.UsedRange.Row + 1)
This function gives all 4 limits of the used range:
Function FindUsedRangeLimits()
Set Sheet = ActiveSheet
Sheet.UsedRange.Select
' Display the range's rows and columns.
row_min = Sheet.UsedRange.Row
row_max = row_min + Sheet.UsedRange.Rows.Count - 1
col_min = Sheet.UsedRange.Column
col_max = col_min + Sheet.UsedRange.Columns.Count - 1
MsgBox "Rows " & row_min & " - " & row_max & vbCrLf & _
"Columns: " & col_min & " - " & col_max
LastCellBeforeBlankInColumn = True
End Function
Timings on Excel 2013 fairly slow machine with a big bad used range million rows:
26ms Cells.Find xlPrevious method (as above)
0.4ms Sheet.UsedRange (just call it)
0.14ms Counta binary search + 0.4ms Used Range to start search (12 CountA calls)
So the Find xlPrevious is quite slow if that is of concern.
The CountA binary search approach is to first do a Used Range. Then chop the range in half and see if there are any non-empty cells in the bottom half, and then halve again as needed. It is tricky to get right.
Here's another one. It looks for the first and last non empty cell and builds are range from those. This also handles cases where your data is not rectangular and does not start in A1. Furthermore it handles merged cells as well, which .Find skips when executed from a macro, used on .Cells on a worksheet.
Function getUsedRange(ByRef sheet As Worksheet) As Range
' finds used range by looking for non empty cells
' works around bug in .Find that skips merged cells
' by starting at with the UsedRange (that may be too big)
' credit to https://contexturesblog.com/archives/2012/03/01/select-actual-used-range-in-excel-sheet/
' for the .Find commands
Dim excelsUsedRange As Range
Dim lastRow As Long
Dim lastCol As Long
Dim lastCell As Range
Dim firstRow As Long
Dim firstCol As Long
Dim firstCell As Range
Set excelsUsedRange = ActiveSheet.UsedRange
lastRow = excelsUsedRange.Find(What:="*", _
LookIn:=xlValues, SearchOrder:=xlRows, _
SearchDirection:=xlPrevious).Row
lastCol = excelsUsedRange.Find(What:="*", _
LookIn:=xlValues, SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
Set lastCell = sheet.Cells(lastRow, lastCol)
firstRow = excelsUsedRange.Find(What:="*", After:=lastCell, _
LookIn:=xlValues, SearchOrder:=xlRows, _
SearchDirection:=xlNext).Row
firstCol = excelsUsedRange.Find(What:="*", After:=lastCell, _
LookIn:=xlValues, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext).Row
Set firstCell = sheet.Cells(firstRow, firstCol)
Set getUsedRange = sheet.Range(firstCell, lastCell)
End Function
This is a different approach to the other answers, which will give you all the regions with data - a Region is something enclosed by an empty row and column and or the the edge of the worksheet. Basically it gives all the rectangles of data:
Public Function ContentRange(ByVal ws As Worksheet) As Range
'First, identify any cells with data, whose neighbourhood we will inspect
' to identify contiguous regions of content
'For efficiency, restrict our search to only the UsedRange
' NB. This may be pointless if .SpecialCells does this internally already, it probably does...
With ws.UsedRange 'includes data and cells that have been formatted
Dim cellsWithContent As Range
On Error Resume Next '.specialCells will error if nothing found, we can ignore it though
Set cellsWithContent = .SpecialCells(xlCellTypeConstants)
Set cellsWithContent = Union(cellsWithContent, .SpecialCells(xlCellTypeFormulas))
On Error GoTo 0
End With
'Early exit; return Nothing if there is no Data
If cellsWithContent Is Nothing Then Exit Function
'Next, loop over all the content cells and group their currentRegions
' This allows us to include some blank cells which are interspersed amongst the data
' It is faster to loop over areas rather than cell by cell since we merge all the CurrentRegions either way
Dim item As Range
Dim usedRegions As Range
For Each item In cellsWithContent.Areas
'Debug.Print "adding: "; item.Address, item.CurrentRegion.Address
If usedRegions Is Nothing Then
Set usedRegions = item.CurrentRegion 'expands "item" to include any surrounding non-blank data
Else
Set usedRegions = Union(usedRegions, item.CurrentRegion)
End If
Next item
'Debug.Print cellsWithContent.Address; "->"; usedRegions.Address
Set ContentRange = usedRegions
End Function
Used like:
Debug.Print ContentRange(Sheet1).Address '$A$1:$F$22
Debug.Print ContentRange(Sheet2).Address '$A$1:$F$22,$N$5:$M$7
The result is a Range object containing 1 or more Areas, each of it which will represent a data/formula containing region on the sheet.
It is the same technique as clicking in all the cells in your sheet and pressing Ctrl+T, merging all those areas. I'm using it to find potential tables of data

Resources