Referencing a Range object set by Range.Row() generates Error 1004 "Application-defined or object-defined error" - excel

I've created a range object by setting it from another range object's Rows(). When I reference the newly created range by row and column, it generates error 1004.
I can reference the original range by row and column. I've included checks to make sure the rng object points to the same range as the dataset object. When I inspect the rng object, the Value2 shows a single row of data.
Below is the minimum code I'm using that generates the error.
Private Sub TestRangeObject()
Dim i As Long
Dim dataset As Range
Dim rng As Range
Set dataset = sRoster.Range("B18:E37")
For i = 1 To dataset.Rows.Count
Set rng = dataset.Rows(i)
Debug.Print "Rng is Range Obj: " & (TypeOf rng Is Range)
Debug.Print "Same worksheet: " & (rng.Parent.CodeName = dataset.Parent.CodeName)
Debug.Print "Same address: " & (dataset.Rows(i).Address = rng.Address)
'can reference dataset object by row and column
Debug.Print "First column (dataset): " & dataset(i, 1).Address
'error when referencing rng object by row and column
Debug.Print "First column (rng): " & rng(1, 1).Address
Next i
End Sub

As additional detail: there's a difference between using Rows(somerow) and Range(somerange).
This can be validated with a simple example:
Sub Test()
Dim rng As Range
Set rng = Sheet1.Range("1:1")
Debug.Print rng(1, 1).Address ' returns $A$1
Dim rng2 As Range
Set rng2 = Sheet1.Rows(1)
Debug.Print rng2(1).Address ' succeeds, returns $1:$1
Debug.Print rng2(1, 1).Address ' fails
End Sub
The solution - to use Rows(myRow).Cells - has already been proposed.
EDIT:
In an attempt to capture and summarize some of the back and forth from comments, a Row, whether it's Range.Rows(somerow) or Sheet.Rows(somerow), refers to a unit as a row, not as individual cells.
For example, Range("A1:E10").Rows would refer to 10 rows, not 50 cells.
In the same way, Sheet1.Rows(1) refers to 1 row, not 16384 cells. The row is the "smallest unit of consideration," for lack of a better term. One row can't have a column index - it's just one row, not a collection of all the cells that make up that row, which each have their own column index.
So you'll need to use Cells if you specifically want to index the cells in a certain row.

You can't use:
rng(1, 1)
if rng is a single row range:
Sub jksfhsa()
Dim sRoster As Worksheet, dataset As Range, rng As Range
Set sRoster = Sheets("Sheet1")
Set dataset = sRoster.Range("B18:E37")
Set rng = dataset.Rows(1)
MsgBox dataset.Address
MsgBox dataset(1, 1).Address
MsgBox rng.Address
MsgBox rng(1, 1).Address
End Sub
The last MsgBox will fail.
However:
Sub jksfhsa()
Dim sRoster As Worksheet, dataset As Range, rng As Range
Set sRoster = Sheets("Sheet1")
Set dataset = sRoster.Range("B18:E37")
Set rng = dataset.Rows(1).Cells
MsgBox dataset.Address
MsgBox dataset(1, 1).Address
MsgBox rng.Address
MsgBox rng(1, 1).Address
End Sub
will work just fine. So in your code replace:
Set rng = dataset.Rows(i)
with:
Set rng = dataset.Rows(i).Cells

Related

Creating Named Range From data with criteria

I came across this code that was provided on a prior question on this topic. It is the exact issue I am trying to solve.
I pasted the code, changed the column range to "A", as my values are in Columns A & B. Column A is my "Category" or criteria and I want Column B to be the values displayed in the named range.
Here is my column data:
When I run the code, I am getting an error:
1004: Method 'Range' of object'_Worksheet'Failed
It Debugs at:
Set rng = sht.Range(cell.Offset(0,1))
Here is the code I am using:
Dim featuresRng As Range
Dim rng As Range
Dim sht As Worksheet
Dim counter As Long
Dim cell As Range
Set sht = ThisWorkbook.Worksheets("Category Details")
Set featuresRng = sht.Range(sht.Range("A1"), sht.Range("A" & sht.Rows.Count).End(xlUp)) 'dynamically set the range of features
counter = 0 'this counter will help us avoid Union(Nothing, some range), which would give an error
For Each cell In featuresRng 'loop through the range of features
If cell.Value = "Essential Oils" Then
counter = counter + 1
If counter = 1 Then
Set rng = sht.Range(cell.Offset(0, 1))
Else
Set rng = Union(rng, sht.Range(cell.Offset(0, 1))) 'build the range
End If
End If
Next cell
Debug.Print rng.Address
sht.Names.Add "Something", rng
End Sub`

How to switch the code from Select Range (Input Box) to Row Count?

Current Code is provided below. The user selects the Range of cells from which unique values needs to be found out. Instead of this, I know the Range of cells which is entire Column B of Sheet Database. I tried switching the code by the code below but it's giving "Run-time error '424': Object Required" where I am trying to count the number of rows with data.
Sheets("Database").Activate
last_row = Cells(Row.Count, "B").End(xlUp).Row <- Error
Set rngTarget = Sheets("Database").Range("B2:B" & last_row)
If rngTarget Is Nothing Then Exit Sub
Current Code:
strPrompt = "Select the Range from which you'd like to extract uniques"
On Error Resume Next
Set rngTarget = Application.InputBox(strPrompt, "Get Range", Type:=8)
On Error GoTo 0
If rngTarget Is Nothing Then Exit Sub
Changed Code: (Doesn't work - Gives Run-Time Error)
Sheets("Database").Activate
last_row = Cells(Row.Count, "B").End(xlUp).Row <- Error
Set rngTarget = Sheets("Database").Range("B2:B" & last_row)
If rngTarget Is Nothing Then Exit Sub
rngTarget function should contain the range of cells from which unique values needs to be found out.
Update 1
Complete Code for reference:
Public Sub WriteUniquesToNewSheet()
Dim wksUniques As Worksheet
Dim rngUniques As Range, rngTarget As Range
Dim strPrompt As String
Dim varUniques As Variant
Dim lngIdx As Long
Dim last_row As Long
Dim colUniques As Collection
Set colUniques = New Collection
'Prompt the user to select a range to unique-ify
'strPrompt = "Select the Range from which you'd like to extract uniques"
'On Error Resume Next
' Set rngTarget = Application.InputBox(strPrompt, "Get Range", Type:=8)
'On Error GoTo 0
'If rngTarget Is Nothing Then Exit Sub '<~ in case the user clicks Cancel
Sheets("Database").Activate
last_row = Cells(Row.Count, 2).End(xlUp).Rows
Set rngTarget = Sheets("Database").Range("B2:B" & last_row)
If rngTarget Is Nothing Then Exit Sub
'Collect the uniques using the function we just wrote
Set colUniques = CollectUniques(rngTarget)
'Load a Variant array with the uniques
'(in preparation for writing them to a new sheet)
ReDim varUniques(colUniques.Count, 1)
For lngIdx = 1 To colUniques.Count
varUniques(lngIdx - 1, 0) = CStr(colUniques(lngIdx))
Next lngIdx
'Create a new worksheet (where we will store our uniques)
Set wksUniques = Worksheets("Lists")
Set rngUniques = wksUniques.Range("A2:A" & colUniques.Count + 1)
rngUniques = varUniques
'Let the user know we're done!
MsgBox "Finished!"
End Sub
To get you started, you have refered to Row instead of a range object representing all Rows. Follow the links to see the difference :)
Next you have used .Activate and therefor not specified what worksheet you working from. A better practice would be to use something like:
With Thisworkbook.Sheets("Database") 'Can even be dereferenced from worksheets collection
last_row = .Cells(.Rows.Count, "B").End(xlUp).Row
Set rngTarget = .Range("B2:B" & last_row) 'Tricky if last_row is 1
If rngTarget Is Nothing Then Exit Sub 'Superfluous and can be deleted
End with

Trying to create dynamic copy and replace function using special cells

I am trying to create a code that will search for a given column header and copy the contents of the column after first replacing all the blanks with a zero.
I have tried using the following code, but the second parameter for the range function at the bottom does not work when I try to use "lastrow".
lastrow is defined by the numeric last row value, but I cant seem to figure out how to combine that with the alphabetical reference that is given in dbt.address
`Sub replacezeros()
Dim dbt As Range
Dim lastrow As Range
'This is to define last row of array
Set lastrow = Range("A" & Rows.Count).End(xlUp)
Debug.Print lastrow.Row
'This is for Debit
Set dbt = Range("A1:J1").Find("Debit")
Debug.Print dbt.Address
Debug.Print dbt.Cells
'Range(dbt.Address,).SpecialCells(xlCellTypeBlanks) = 0
End Sub`
Hoping to get this to replace all zeros only in that one column that is searched to select "Debit"
Not sure if I've understood your problem - try this:
Sub replacezeros()
Dim dbt As Range
Dim lastrow As Range
'This is to define last row of array
Set lastrow = Range("A" & Rows.Count).End(xlUp)
Debug.Print lastrow.Row
'This is for Debit
Set dbt = Range("A1:J1").Find("Debit")
If Not dbt Is Nothing Then 'avoid error if Debit not found
On Error Resume Next 'avoid error if no blanks
Range(dbt.Offset(1), Cells(lastrow.Row, dbt.Column)).SpecialCells(xlCellTypeBlanks).Value = 0
On Error GoTo 0
End If
End Sub
Something like this should work... (untested though)
Sub replacezeros()
Dim dbt As Range, rData As Range, Cell As Range
Dim lastrow As Long: lastrow = Range("A" & Rows.Count).End(xlUp).Row
'This is for Debit
Set dbt = Range("A1:J1").Find("Debit")
If Not dbt Is Nothing Then
Set rData = Range(Cells(1,dbt.Column),Cells(lastrow, dbt.Column))
For Each Cell In rData.SpecialCells(xlCellTypeBlanks)
Cell.Value = 0
Next Cell
End If
End Sub

Search column headers and insert new column using Excel VBA

I have a spreadsheet that is updated regularly. Therefore the column header positions change regularly. eg. today "Username" is column K, but tomorrow "Username" might be column L. I need to add a new column to the right of "Username" but where it changes I cannot refer to as cell/column reference.
So far I have:
Dim rngUsernameHeader As Range
Dim rngHeaders As Range
Set rngHeaders = Range("1:1") 'Looks in entire first row.
Set rngUsernameHeader = rngHeaders.Find("Username")
When I go to add a new column to the right of it, I'm selecting that row but it's going back to cell/column references...
Columns("K:K").Select
Selection.Insert Shift:=xlToRight
Range("K1").Select
ActiveCell.FormulaR1C1 = "Role"
How can I perform this step with a macro?
edit: I think need to give that Column a header name and begin populating the row with data - each time I do begins the cell references which I want to avoid wherever possible.
Many thanks in advance.
How about:
Sub qwerty()
Dim rngUsernameHeader As Range
Dim rngHeaders As Range
Set rngHeaders = Range("1:1") 'Looks in entire first row.
Set rngUsernameHeader = rngHeaders.Find(what:="Username", After:=Cells(1, 1))
rngUsernameHeader.Offset(0, 1).EntireColumn.Insert
rngUsernameHeader.Offset(0, 1).Value = "role"
End Sub
Sub AddColumn
Dim cl as Range
For each cl in Range("1:1")
If cl = "username" Then
cl.EntireColumn.Insert Shift:= xlToRight
End If
cl.Offset(0, 1) = "role"
Next cl
End Sub
Untested code as not at my desktop
Something like this should work. The idea is that you locate the column and then you insert to the right. That is why you have the +1 in the TestMe. The function l_locate_value_col returns the column, where it has found the value. If you want, you may change the optional parameter l_row, depending on which row do you want to look for.
Option Explicit
Public Sub TestMe()
Dim lngColumn As Long
lngColumn = l_locate_value_col("Username", ActiveSheet)
Cells(1, lngColumn + 1).EntireColumn.Insert
End Sub
Public Function l_locate_value_col(target As String, _
ByRef target_sheet As Worksheet, _
Optional l_row As Long = 1)
Dim cell_to_find As Range
Dim r_local_range As Range
Dim my_cell As Range
Set r_local_range = target_sheet.Range(target_sheet.Cells(l_row, 1), target_sheet.Cells(l_row, Columns.Count))
For Each my_cell In r_local_range
If target = Trim(my_cell) Then
l_locate_value_col = my_cell.Column
Exit Function
End If
Next my_cell
l_locate_value_col = -1
End Function
You could name your range:
Sub Test()
Dim rngUsernameHeader As Range
'UserName is in column F at the moment.
Set rngUsernameHeader = Range("UserName")
Debug.Print rngUsernameHeader.Address 'Returns $F$1
ThisWorkbook.Worksheets("Sheet2").Range("E:E").Insert Shift:=xlToRight
Debug.Print rngUsernameHeader.Address 'Returns $G$1
End Sub
Edit:
Have rewritten so it inserts a column after your named column and returns that reference:
Sub Test()
Dim rngUsernameHeader As Range
Dim rngMyNewColumn As Range
Set rngUsernameHeader = Range("UserName")
rngUsernameHeader.Offset(, 1).Insert Shift:=xlToRight
'You'll need to check the named range doesn't exist first.
ThisWorkbook.Names.Add Name:="MyNewRange", _
RefersTo:="='" & rngUsernameHeader.Parent.Name & "'!" & _
rngUsernameHeader.Offset(, 1).Address
Set rngMyNewColumn = Range("MyNewRange")
MsgBox rngMyNewColumn.Address
End Sub

Get start range and end range of a vertically merged cell with Excel using VBA

I need to find out the first cell and the last cell of a vertically merged cell..
Let's say I merge Cells B2 down to B50.
How can I get in VBA the start cell(=B2) and the end cell(=B50)?
Sub MergedAreaStartAndEnd()
Dim rng As Range
Dim rngStart As Range
Dim rngEnd As Range
Set rng = Range("B2")
If rng.MergeCells Then
Set rng = rng.MergeArea
Set rngStart = rng.Cells(1, 1)
Set rngEnd = rng.Cells(rng.Rows.Count, rng.Columns.Count)
MsgBox "First Cell " & rngStart.Address & vbNewLine & "Last Cell " & rngEnd.Address
Else
MsgBox "Not merged area"
End If
End Sub
Below macro goes through all sheets in a workbook and finds merged cells, unmerge them and put original value to all merged cells.
This is frequently needed for DB applications, so I wanted to share with you.
Sub BirlesenHucreleriAyirDegerleriGeriYaz()
Dim Hucre As Range
Dim Aralik
Dim icerik
Dim mySheet As Worksheet
For Each mySheet In Worksheets
mySheet.Activate
MsgBox mySheet.Name & “ yapılacak…”
For Each Hucre In mySheet.UsedRange
If Hucre.MergeCells Then
Hucre.Orientation = xlHorizontal
Aralik = Hucre.MergeArea.Address
icerik = Hucre
Hucre.MergeCells = False
Range(Aralik) = icerik
End If
Next
MsgBox mySheet.Name & " Bitti!!"
Next mySheet
End Sub
Suppose you merged B2 down to B50.
Then, start cell address will be:
MsgBox Range("B2").MergeArea.Cells(1, 1).Address
End cell address will be:
With Range("B2").MergeArea
MsgBox .Cells(.Rows.Count, .Columns.Count).Address
End With
You can put address of any cell of merged area in place of B2 in above code.
Well, assuming you know the address of one of the cells in the merged range, you could just select the offset from that range and get the row/column:
Sub GetMergedRows()
Range("A7").Select 'this assumes you know at least one cell in a merged range.
ActiveCell.Offset(-1, 0).Select
iStartRow = ActiveCell.Row + 1
Range("A7").Select
ActiveCell.Offset(1, 0).Select
iEndRow = ActiveCell.Row - 1
MsgBox iStartRow & ":" & iEndRow
End Sub
The code above will throw errors if the offset row cannot be selected (i.e. if the merged rows are A1 through whatever) so you will want to add error handling that tells the code if it can't offset up, the top rows must be 1 and if it can't go down, the bottom row must be 65,536. This code is also just one dimensional so you might want to add the x-axis as well.
If you want the cell references as strings, you can use something like this, where Location, StartCell, and EndCell are string variables.
Location = Selection.Address(False, False)
Colon = InStr(Location, ":")
If Colon <> 0 Then
StartCell = Left(Location, Colon - 1)
EndCell = Mid(Location, Colon + 1)
End If
If you want to set them as ranges, you could add this, where StartRange and EndRange are Range objects.
set StartRange = Range(StartCell)
set EndRange = Range (EndCell)
If you intend to loop through the merged cells, try this.
Sub LoopThroughMergedArea()
Dim rng As Range, c As Range
Set rng = [F5]
For Each c In rng.MergeArea
'Your code goes here
Debug.Print c.Address'<-Sample code
Next c
End Sub

Resources