Setting range on other sheet, based on abstract row number - vba

With a sub on sheet1, I need to get data from a range of cells (P.. to W..) from row X, where X is take from a reference cell on sheet2.
Dim final_range As Range
Dim ref_cell_range As Range
Dim ref_cell As Range
Set ref_cell_range = Worksheets("sheet2").Range("O9:O15")
For Each ref_cell In ref_cell_range
Set final_range = Worksheets("sheet2").Range(Cells(ref_cell.Row, "P"), Cells(ref_cell.Row, "W"))
Next ref_cell
This code works if I leave out the 'Worksheets("sheet2").' part, but then it takes the cells from sheet1.
If I run it like this (refencing the sheet to take the range from), I get an error ('Run-time error '1004': Application-defined or object-defined error')
Does anybody know what I might be doing wrong?

Your final_range reference is looking at two sheets.
This is looking at Sheet2:
Worksheets("sheet2").Range(
This is looking at whichever sheet is active as you haven't qualified the sheet for Cells to reference:
Cells(ref_cell.Row, "P"), Cells(ref_cell.Row, "W")
The full line should be:
Set final_range = Worksheets("sheet2").Range(Worksheets("sheet2").Cells(ref_cell.Row, "P"), Worksheets("sheet2").Cells(ref_cell.Row, "W"))
or using With...End With:
Sub Test()
Dim final_range As Range
Dim ref_cell_range As Range
Dim ref_cell As Range
With ThisWorkbook.Worksheets("sheet2")
Set ref_cell_range = .Range("O9:O15")
For Each ref_cell In ref_cell_range
Set final_range = .Range(.Cells(ref_cell.Row, "P"), .Cells(ref_cell.Row, "W"))
Next ref_cell
End With
End Sub

Related

Search words in range on Sheet1 in list of words on Sheet2 and if match then clear word on Sheet1

I have a list of names on one sheet (InputSheet) in the range c6:H200. The names in this range change twice a month. The group of names in the InputSheet are compared to a list of names on another sheet (NameList) in the range e2:e50. For each name that is found on the NameList, I want to remove the name on the InputSheet. I'm new to vba but have written this code and it is not working (getting run time error). Thanks for any help!
Sub RemoveNonWords()
Dim datasheet As Worksheet
Dim cl As Range
Set wordrange = InputSheet.Range("C6:h200")
Set datasheet = NameList.Range("E1:E50").Value
For Each cl In wordrange
If cl = datasheet Then
cl.Selection.ClearContents
End If
Next
Range("A6").Select
End Sub
There's a lot wrong with your posted code. I think in the end, this is what you're looking for, code commented for clarity:
Sub tgr()
Dim wb As Workbook
Dim wsInput As Worksheet
Dim wsNames As Worksheet
Dim rInputData As Range
Dim rNameList As Range
Dim DataCell As Range
Dim rClear As Range
Dim lRow As Long
Set wb = ActiveWorkbook
Set wsInput = wb.Sheets("InputSheet") 'Change to the actual sheet name of your input sheet
Set wsNames = wb.Sheets("NameList") 'Change to the actual sheet name of your name list sheet
'Get last used row of the C:H columns in wsInput
With wsInput.Range("C:H")
lRow = .Find("*", .Cells(1), , , , xlPrevious).Row
If lRow < 6 Then Exit Sub 'No data
End With
'Use the last used row to define your inputdata range, this was hardcoded to C6:H200 in your question
Set rInputData = wsInput.Range("C6:H" & lRow)
'Define the namelist range using all populated cells in column E of wsNames, this was hardcoded to E2:E50 in your question
Set rNameList = wsNames.Range("E2", wsNames.Cells(wsNames.Rows.Count, "E").End(xlUp))
If rNameList.Row < 2 Then Exit Sub 'No data
'Data has been found and ranges assigned
'Now loop through every cell in rInputData
For Each DataCell In rInputData.Cells
'Check if the cell being looked at exists in the NameList range
If WorksheetFunction.CountIf(rNameList, DataCell.Value) > 0 Then
'Found to exist, add the cell to the Clear Range
If rClear Is Nothing Then
Set rClear = DataCell 'First matching cell added
Else
Set rClear = Union(rClear, DataCell) 'All subsequent matching cells added
End If
End If
Next DataCell
'Test if there were any matches and if so clear their contents
If Not rClear Is Nothing Then rClear.ClearContents
End Sub

Excel stopped working while using find

I'm Working on a code to find a row which has "1263_Estamp_En" in Range "J1" and wan to select the same column and paste it to another workbook but while running the code excel stop working and restart itself, please help how can I search the range and select the value. Below is the code...
Sub Search()
Dim A As Range
Dim myRng As Range
Dim R As Range
Dim Col
ThisWorkbook.Sheets("Result").Activate
Set R = Range("A1:Z1")
ThisWorkbook.Sheets("Sheet1").Activate
Set A = Range("A1")
myRng = R.Find(what:=Str(A), LookIn:=xlValue)
Cells(myRng.Row, myRng.Column).Select
Col = Selection.Column
Col.select
Range(selection,selection.end(xldown)).copy
Thisworkbook.Sheets("Sheet2").Activate
Range("A1").Pastespecial xlPasteValues
End Sub
I think you are looking for something like the code below (without all the unnecessarily Activate, Selection and Select):
Option Explicit
Sub Search()
Dim A As Range
Dim myRng As Range
Dim R As Range
Dim Col
Set R = Sheets("Result").Range("A1:Z1")
Set A = Sheets("Sheet1").Range("A1")
Set myRng = R.Find(what:=CStr(A.Value), LookIn:=xlValue, lookat:=xlWhole)
If Not myRng Is Nothing Then ' <-- check if Find was successful
' rest of your code goes here
myRng.EntireColumn.Copy <-- copy entire Column where found
Sheets("Sheet2").Range("A1").PasteSpecial xlPasteValues
End If
End Sub

Syntax Error with Named Range

I cannot seem to get the syntax corrects as follows:
Sheet(DCRLog) has a named range at AE365 called EndSrtRnge
I am trying to sort the spreadsheet From A3 to AE365
Dim StSrtRnge As Range
Set StSrtRnge = Range("A3")
Dim NdSrtRnge As Range
Set NdSrtRnge = Range("EndSrtRnge")
Dim SortRnge As Range
Set SortRnge = Range(StSrtRnge:NdSrtRnge)*********Syntax Error
The final Statement used is
SortRnge.Sort Key1:=SortKey, Order1:=xlAscending, Header:=xlYes
You should use :
Set SortRnge = Range(StSrtRnge,NdSrtRnge)
Or with your syntax, you need :
Set SortRnge = Range(StSrtRnge.Address & ":" & NdSrtRnge.Address)
Range expects two cells separated by a comma or a string address.
Currently RANGE("A3") and Range("EndSrtRnge") may be on different sheets if the wrong sheet is acitve when Range("A3") is set - you haven't specified the sheet it's on.
Sub Test()
Dim NdSrtRnge As Range
Set NdSrtRnge = Range("EndSrtRnge")
Dim StSrtRnge As Range
'Ensure the start range is on the same sheet as the named range.
'Using just RANGE will place it on the currently active sheet.
Set StSrtRnge = NdSrtRnge.Parent.Range("A3")
Dim SortRnge As Range
Set SortRnge = NdSrtRnge.Parent.Range(StSrtRnge, NdSrtRnge)
End Sub
Just double checked - setting EndSrtRnge on Sheet1 and then selecting Sheet2 before running the code produced an Application-defined or object-defined error when using just Range("A3").

clean all cells containing no formula in a worksheet using vba?

I am using the following code to clean all cells dose not containing a formula.
Sub DoNotContainClearCells()
Dim rng As Range
Dim cell As Range
Dim ContainWord As String
'What range ?
Set rng = Worksheets("Datenbasis").Range("A5:Z100")
'What I am looking for?
ContainWord = "="
For Each cell In rng.Cells
If cell.Find(ContainWord) Is Nothing Then cell.Clear
Next cell
End Sub
But I get the run time error 1004 and just the first column is removed. How can I treat this error? Is there any better way to delete cells from a sheet which dose not contain a formula?
Consider:
Sub DoNotContainClearCells()
Dim rng As Range
Set rng = Worksheets("Datenbasis").Range("A5:Z100")
rng.Cells.SpecialCells(xlCellTypeFormulas).Clear
End Sub
EDIT#1:
If you wish to clear cells not containing formulas then:
Sub DoNotContainClearCells()
Dim rng As Range
Set rng = Worksheets("Datenbasis").Range("A5:Z100")
rng.Cells.SpecialCells(xlCellTypeConstants).Clear
End Sub
will leave the formula cells alone!.
Try with below
Sub DoNotContainClearCells()
Dim rng As Range
Dim cell As Range
'What range ?
Set rng = Worksheets("Datenbasis").Range("A5:Z100")
For Each cell In rng.Cells
If Not cell.HasFormula Then cell.Clear
Next cell
End Sub

Copy and pasting information within a for loop

I would like to create a function that copies certain excel ranges in worksheets and paste these ranges into a "motherfile".
Now, I am trying with this code:
Sub ranges()
Dim month As Variant
Dim months As Variant
months = Array("V01 DEN HAAG", "V02 AMSTERDAM")
Dim destinationRange As Excel.range
Set destinationRange = Sheets("DATASET").range("B3").End(xlDown).Offset(1, 0)
For Each month In months
Dim sourceRange As Excel.range
Set sourceRange = Sheets(month).range("H7", range("H7").End(xlToRight))
Call sourceRange.Copy
Call destinationRange.PasteSpecial
Next month
End Sub
But, I get an Application-defined or object-defined error. Any thoughts on what goes wrong? Thanks!
Adding to mielk's anwser the problem is in the codeline:
Set sourceRange = Sheets(month).range("H7", range("H7").End(xlToRight))
This is because if you are collecting from multiple sheets data and you use range("H7").End(xlToRight it will search for this on the active sheet. Therefor it can only find the correct range if its on the correct sheet.
by using the following code:
Set sourceRange = Sheets(month).Range("H7", Sheets(month).Range("H7").End(xlToRight))
it will work no matter which sheet is active at that moment.
another addition is you can copy and paste in 1 code line:
sourceRange.Copy Destination:=destinationRange
see below the entire code:
Sub ranges()
Dim month As Variant
Dim months As Variant
months = Array("V01 DEN HAAG", "V02 AMSTERDAM")
For Each month In months
Dim sourceRange As Excel.Range
Dim destinationRange As Excel.Range
With Sheets("DATASET")
Set destinationRange = .Cells(.Rows.Count, 2).End(xlUp).Offset(1, 0)
End With
Set sourceRange = Sheets(month).Range("H7", Sheets(month).Range("H7").End(xlToRight))
sourceRange.Copy Destination:=destinationRange
Next month
End Sub
The possibly reason for this error is that you don't have any values in worksheet "DATASET", column B, below 3. row.
Look at this line of code:
Set destinationRange = Sheets("DATASET").range("B3").End(xlDown).Offset(1, 0)
First it takes the range from cell B3 to the last cell in this column (B1048576 in Excel 2007+).
After that it tries to offset this range by one row down (so it tries to create a range having the same number of rows and columns but starting one cell below).
However, it is not possible, because such range would have to start in cell B4 and end in cell B1048577 and Excel has only 1048576 rows.
If you want to assign the first empty row to the variable destinationRange you should replace this code:
Set destinationRange = Sheets("DATASET").range("B3").End(xlDown).Offset(1, 0)
with the below:
With Sheets("DATASET")
Set destinationRange = .Cells(.Rows.Count, 2).End(xlUp).Offset(1, 0)
End With
Both those statements are similar. The difference is that the second one
starts from the last cell in the column B and look for the first non-empty
cell above.