Defined Range Not producing a Value for VBA - excel

There's probably a simple fix here, but my defined range is not being picked up.
I have an evolving set of data that will refresh. When I run the macro, I want to set a range for the values in the last 5 rows of the table to check win / loss (in column H) for a Count If function. But when I run the VBA trouble shoot command, a range value never gets set and my formula fails for Run-time error 1004. I've tried with both Selection.Offset and ActiveCell.Offset.
I feel like I'm making a basic mistake, but can narrow it down or easily find examples here to replicate
Dim fivegame As Range
Range("H1").Select
Selection.End(xlDown).Select
Set fivegame = Range(Selection.Offset(-4, 0), Selection)

Where do you get the error? Does this work?
Dim fivegame As Range
Set fivegame = Range("H" & Rows.Count).End(xlUp).Offset(-4).Resize(5)

Create a Reference to the Last Cells in a Column
The function refLastCellsInColumn will return a reference to the range consisting of the last cells in a column i.e. the number of consecutive cells above the last non-empty cell (incl.) defined by the parameter (number) supplied to the NumberOfCells argument. The function will return Nothing if the reference cannot be created (e.g. the range is supposed to start with a cell above the first cell...).
The Code
Option Explicit
Sub HowToUseItInYourProcedure()
Dim fivegame As Range
Set fivegame = refLastCellsInColumn(Range("H1"), 5)
End Sub
Function refLastCellsInColumn( _
ByVal FirstCell As Range, _
Optional ByVal NumberOfCells As Long = 1, _
Optional ByVal allowLessCells As Boolean = False) _
As Range
If Not FirstCell Is Nothing And NumberOfCells > 0 Then
With FirstCell
Dim rg As Range
Set rg = .Resize(.Worksheet.Rows.Count - .Row + 1) _
.Find("*", , xlFormulas, , , xlPrevious)
If Not rg Is Nothing Then
If rg.Row - .Row >= NumberOfCells - 1 Then
Set refLastCellsInColumn = _
rg.Offset(1 - NumberOfCells).Resize(NumberOfCells)
Else
If allowLessCells Then
Set refLastCellsInColumn = .Resize(rg.Row - .Row + 1)
End If
End If
End If
End With
End If
End Function
Sub refLastCellsInColumnTEST()
Const FirstCellAddress As String = "H1"
Const NumberOfCells As Long = 2000000
' Define First Cell Range.
Dim cel As Range: Set cel = Range("H1")
' Define Last Cells in column.
Dim rg As Range: Set rg = refLastCellsInColumn(cel, NumberOfCells, True)
' Test.
If Not rg Is Nothing Then
Debug.Print rg.Address
Else
Debug.Print "Nope"
End If
End Sub

Related

How to select entire column except header

I am using below code.
Sub Replace_specific_value()
'declare variables
Dim ws As Worksheet
Dim xcell As Range
Dim Rng As Range
Dim newvalue As Long
Set ws = ActiveSheet
Set Rng = ws.Range("G2:G84449")
'check each cell in a specific range if the criteria is matching and replace it
For Each xcell In Rng
xcell = xcell.Value / 1024 / 1024 / 1024
Next xcell
End Sub
Here i don't want to specify G2:G84449 , how do i tell VBA to pick all value instead of specifying range?
Watch: Excel VBA Introduction Part 5 - Selecting Cells (Range, Cells, Activecell, End, Offset)
Here is the standard way to get the used cell in column G starting at G2:
With ws
Set Rng = .Range("G2", .Cells(.Rows.Count, "G").End(xlUp))
End With
If the last row could be hidden use:
With ws
Set Rng = Intersect(.Range("A1", .UsedRange).Columns("G").Offset(1), .UsedRange)
End With
If Not Rng Is Nothing Then
'Do Something
End If
Reference Column Data Range (w/o Headers)
If you know that the table data starts in the first row of column G, by using the Find method, you can use something like the following (of course you can use the more explicit
With ws.Range("G2:G" & ws.Rows.Count) instead, in the first With statement).
Option Explicit
Sub BytesToGigaBytes()
Const Col As String = "G"
Dim ws As Worksheet: Set ws = ActiveSheet 'improve!
With ws.Columns(Col).Resize(ws.Rows.Count - 1).Offset(1) ' "G2:G1048576"
Dim lCell As Range: Set lCell = .Find("*", , xlFormulas, , , xlPrevious)
If lCell Is Nothing Then Exit Sub ' empty column
With .Resize(lCell.Row - .Row + 1) ' "G2:Glr"
.Value = ws.Evaluate("IFERROR(IF(ISBLANK(" & .Address & "),""""," _
& .Address & "/1024/1024/1024),"""")")
End With
End With
End Sub
Here's a slightly different approach that works for getting multiple columns, as long as your data ends on the same row:
set rng = application.Intersect(activesheet.usedrange, activesheet.usedrange.offset(1), range("G:G"))
This takes the intersection of the used range (the smallest rectangle that holds all data on the sheet, with the used range offset by one row (to exclude the header), with the columns you are interested in.

Excel VBA | Include Blank Cells Below an Already Selected Cell In a Range

I have a script partially written. I'm stuck on how to include all blank cells below a selected cell and store this as a range. My script selects the top cell in the range I want - Cell N39 - and I want to select each of the blank cells below it. That is, I want to select N39 thru N42 and name it as a range.
I know there are other ways to capture this range (ie - all of the "BlankNonUSD" descriptions I add on the far right could help me). But the only way I can grab only the data I need and not accidentally include data I don't need is to select this "N39" cell and every empty cell below it. I want to ensure this script can run for all sheets it will be used for and this is the way to do it.
I have my script below and a link to the picture of the sheet I referenced. Any help would be highly appreciated!
Script:
'Convert "BlankNonUSD" and move values to "Amount USD" (Column N)
For i = 1 To IDLastRow
If Cells(i, 16) = "BlankNonUSD" And Cells(i, 14) <> "" Then
Range("N" & i).Select
'This is where I also want to select all cells below
'Dim r As Range
'Set r = Selection
'Dim x As Integer
'Dim y As Integer
'x = r.Rows
'y = r.Rows.Count + x - 1
'Dim USDTotal As Integer
'USDTotal = Range("N" & i).Value
'Dim nonUSDTotal As Integer
'nonUSDTotal = ActiveSheet.Sum(r)
'For Z = x To y
'Cells(i, 17) = Round(((Cells(i, 14).Value / nonUSDTotal) * USDTotal), 2)
'Next
End If
Next
Picture of Sheet
Reference Cell and Blanks Adjacent to the Bottom
In your code you would call the function in the following way:
RefCellBottomBlanks(Range("N" & i)).Select
The Function
Function RefCellBottomBlanks( _
ByVal FirstCell As Range) _
As Range
With FirstCell.Cells(1)
Dim lCell As Range: Set lCell = _
.Resize(.Worksheet.Rows.Count - .Row + 1).Find("*", , xlValues)
If lCell Is Nothing Then Exit Function ' no data in column
If lCell.Row <= .Row + 1 Then ' no blanks adjacent to the bottom
Set RefCellBottomBlanks = .Cells
Else
Set RefCellBottomBlanks = .Resize(lCell.Row - .Row)
End If
End With
End Function
A Test Procedure
Sub RefCellBottomBlanksTEST()
Const fCellAddress As String = "N39"
Dim ws As Worksheet: Set ws = ActiveSheet
Dim fCell As Range: Set fCell = ws.Range(fCellAddress)
Dim rg As Range: Set rg = RefCellBottomBlanks(fCell)
Debug.Print rg.Address
End Sub

Reliably get Last Column in Excel with or without Merged Cells

I recently ran into an issue where my get_lcol function returned A1 as the cells in A1:D1 were merged. I adapted my function to account for this, but then I had some other data with cells merged in A1:D1 but another column in G and my function returned D1 so I adjusted it again. The problem is I don't trust it still to work with all data types as its only checking merged cells in row 1.
Take a look at the below data, how can I reliably get the function to return D or 4 regardless of where I move the merged row and/or any other issues I haven't foreseen?
Current Function:
Public Sub Test_LCol()
Debug.Print Get_lCol(ActiveSheet)
End Sub
Public Function Get_lCol(WS As Worksheet) As Integer
Dim sEmpty As Boolean
On Error Resume Next
sEmpty = IsWorksheetEmpty(Worksheets(WS.Name))
If sEmpty = False Then
Get_lCol = WS.Cells.Find(What:="*", after:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
If IsMerged(Cells(1, Get_lCol)) = True Then
If Get_lCol < Cells(1, Get_lCol).MergeArea.Columns.Count Then
Get_lCol = Cells(1, Get_lCol).MergeArea.Columns.Count
End If
End If
Else
Get_lCol = 1
End If
End Function
Update:
Try this data w/ function:
This is a twist on the classic "Find Last Cell" problem
To state the aim:
find the column number of the right most cell containing data
consider merged cell areas that extend beyond other cells containing data. Return the right most column of a merged area should that extend beyond other data.
exclude formatted but empty cells and merged areas
The approach:
Use Range.Find to locate the last data cell
If the last column of the Used Range = Found last data cell column, return that
Else, loop from the last column of the Used Range back to the found data cell column
test for data in that column (.Count > 0), if true return that
test for merged cells in that column (IsNull(.MergeCells))
if found, loop to find the merged area
test the left most cell of the merged area for data
if found return the search column
Note
this may still be vulnerable to other "Last data" issues, eg Autofilter, Hidden rows/columns etc. I haven't tested those cases.
Has the advantage of limiting the search for merged cells to the relavent right most columns
Function MyLastCol(ws As Worksheet) As Long
Dim ur As Range
Dim lastcell As Range
Dim col As Long
Dim urCol As Range
Dim urCell As Range
Set ur = ws.UsedRange
Set lastcell = ws.Cells.Find("*", ws.Cells(1, 1), xlFormulas, , xlByColumns, xlPrevious)
For col = ur.Columns.Count To lastcell.Column - ur.Column + 2 Step -1
Set urCol = ur.Columns(col)
If Application.CountA(urCol) > 0 Then
MyLastCol = urCol.Column
Exit Function
End If
If IsNull(urCol.MergeCells) Then
For Each urCell In urCol.Cells
If urCell.MergeCells Then
If Not IsEmpty(urCell.MergeArea.Cells(1, 1)) Then
MyLastCol = urCol.Column
Exit Function
End If
End If
Next
End If
Next
MyLastCol = lastcell.Column
End Function
#Toddleson got me on the right track, here is what I ended with:
Public Sub Test_LCol()
Debug.Print Get_lCol(ActiveSheet)
End Sub
Public Function Get_lCol(WS As Worksheet) As Integer
On Error Resume Next
If Not IsWorksheetEmpty(WS) Then
Get_lCol = WS.Cells.Find(What:="*", after:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Dim Cell As Range
For Each Cell In WS.UsedRange
If Cell.MergeCells Then
With Cell.MergeArea
If .Cells(.Cells.Count).Column > Get_lCol Then Get_lCol = .Cells(.Cells.Count).Column
End With
End If
Next Cell
Else
Get_lCol = 1
End If
End Function
The Find Method Backed Up by the UsedRange Property: What?
Talking about wasting time...
Option Explicit
Function GetLastColumn( _
ByVal ws As Worksheet) _
As Long
If ws Is Nothing Then Exit Function
' Using the 'Find' method:
'If ws.AutoFilterMode Then ws.AutoFilterMode = False ' (total paranoia)
Dim lcCell As Range
Set lcCell = ws.Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious)
If Not lcCell Is Nothing Then
GetLastColumn = lcCell.Column
End If
Debug.Print "After 'Find': " & GetLastColumn
' Using the 'UsedRange' property (paranoia):
Dim rg As Range: Set rg = ws.UsedRange
Dim clColumn As Long: clColumn = rg.Columns.Count + rg.Column - 1
If clColumn > GetLastColumn Then
If rg.Address(0, 0) = "A1" Then
If IsEmpty(rg) Then
Exit Function
End If
End If
GetLastColumn = clColumn
'Else ' clColumn is not gt GetLastColumn
End If
Debug.Print "Final (if not 0): " & GetLastColumn
End Function
Sub GetLastColumnTEST()
Debug.Print "Sub Result: " & GetLastColumn(Sheet1)
Debug.Print Sheet1.UsedRange.Address(0, 0)
End Sub
' It works for a few (?) cells, otherwise it returns 'Null'.
Sub TestMergeCells() ' Useless?! Could someone confirm.
Debug.Print Sheet1.Cells.MergeCells ' Null for sure
Debug.Print Sheet1.UsedRange.MergeCells
End Sub

VBA Excel select content after the character occurrence

I want to select the content of my worksheet after the character occurrence in the row.
The code I have been using so far selects all the stuff after the offset.
Sub Selection ()
Dim Target_Start As Range, Target_End As Range
Dim n as long
Set Target_Start = work.Cells.Find("X", SearchOrder:=xlByColumns).Offset(1)
Set Target_End = Target_Start.End(xlDown).End(xlToRight)
work.Range(Target_Start, Target_End).Select
'Selection.EntireRow.Clear
End Sub
What should I alter in my code?
Select Used Range After a Cell
If you want to allow a lower-case "X" then replace True with False (MatchCase).
Note that this solution will include row 15 in your image which may be only formatted (borders, no values), because we are using Used Range. If you don't like that, you will have to use another way to define the range.
Option Explicit
Sub selectAfter()
Const sString As String = "X"
With work.UsedRange
Dim rg As Range
Set rg = .Find(sString, .Cells(.Rows.Count, .Columns.Count), _
xlFormulas, xlWhole, xlByRows, , True)
If Not rg Is Nothing Then
Dim Offs As Long: Offs = rg.Row - .Row + 1
Set rg = .Resize(.Rows.Count - Offs).Offset(Offs)
rg.Select
End If
End With
End Sub

How to locate the last row of cells in a range which matches using VBA?

There is one column in a table where names of factories are shown but I only need the data for a specific factory name(let's say factory "Australia").
My idea is to locate the first and last rows which match because the data for the same factory are always presented in a consecutive manner. In this way, I can get the range of cells which match up to my search.
Locating the first matched row position is quite easy but I get stuck in getting the last matched row position.
Here is the code regarding this section:
Sub Search()
Dim sh As Worksheet
Dim searchStr As String
Dim lastRow As Long, firstRow as Long
Dim tableRange As range
Set sh = Worksheets("Total order")
searchStr = "Australia"
Set tableRange = sh.range("B:B").Find(what:=searchStr, LookIn:=xlValues, lookat:=xlWhole)
firstRow = tableRange.Row
End Sub
An example of the table dealt with:
Refer to the Range from the Cell of the First to the Cell of the Last Occurrence of a String in a Column
A Side Note
The Range.Find method is kind of tricky. For example, you may not be aware that in your code the search starts from cell B2 (which is even preferable in this case), and using xlValues may result in undesired results if rows are hidden (probably not important).
Usage
Using the function, according to the screenshot, you could (after searchStr = "Australia") use:
Set tableRange = refRangeFirstLast(sh.Columns("B"), searchStr)
to refer to the range B4:B7, or use:
Set tableRange = refRangeFirstLast(sh.Columns("B"), searchStr).Offset(, -1).Resize(, 4)
to refer to the range A4:D7.
The Code
Function refRangeFirstLast( _
ByVal ColumnRange As Range, _
ByVal SearchString As String) _
As Range
If Not ColumnRange Is Nothing Then
With ColumnRange
Dim FirstCell As Range: Set FirstCell = _
.Find(SearchString, .Cells(.Cells.Count), xlFormulas, xlWhole)
If Not FirstCell Is Nothing Then
Dim LastCell As Range: Set LastCell = _
.Find(SearchString, , xlFormulas, xlWhole, , xlPrevious)
Set refRangeFirstLast = .Worksheet.Range(FirstCell, LastCell)
End If
End With
End If
End Function
Sub refRangeFirstLastTEST()
Const SearchString As String = "Australia"
Dim ColumnRange As Range
Set ColumnRange = ThisWorkbook.Worksheets("Total order").Columns("B")
Dim rg As Range: Set rg = refRangeFirstLast(ColumnRange, SearchString)
If Not rg Is Nothing Then
Debug.Print rg.Address
Else
MsgBox "The reference could not be created.", vbExclamation, "Fail?"
End If
End Sub

Resources