Range Error - Loop to increase row index vba - vba

This is a portion of my code. In the end, I want to loop through cells, find the text in between two phrases, concatenate that, and paste it into determined columns. Once the code finds "ID", it will add a row to the paste range, and start over. (this is near the bottom).
What I can't do, is get the range in each section to cooperate. When I use 'wksSource.Range(Cells(R, 2)).Value = stringValues' it throws the error: 1004, Method range of object worksheet failed. But if I use 'wksSource.Range("B15").Value = stringValues' it is completely fine. The problem is, that isn't dynamic. I need 'R' to increase everytime the phrase "ID" is found. The columns will be constant for each section. (R,2) (R,3) etc.
I've done so much googling and I understand why that error is thrown; I just can't figure out why it's happening in this instance. Worksheet is defined... and it works with "B15", so I'm thinking the error is in the "R", but I am stuck.
Please help! (I realize this could probably be a loop all the way, and I'd love to hear advice on that if you want, but for now, I am trying to learn and it seems the best way for me to do that is one piece at a time. Increase rows with a small loop today, tackle big loops tomorrow. :))
Dim rng As Range, AllPos As Range, rngEnd As Range, rngStart As Range
Dim DeptRng As Variant, stringValues As String, cell As Range, NextRow As Variant
Dim R As Integer, lastRowCon As Integer, wksSource As Worksheet, paste As Range
Set AllPos = Range("A2:A53")
R = 2
Set wksSource = ActiveWorkbook.Sheets("Sheet1")
Set rngStart = AllPos.Find("Department Description:").Cells
If Not rngStart Is Nothing Then
Set rngEnd = AllPos.Find("Position Duties :").Cells
Set DeptRng = Range(rngStart, rngEnd.Offset(1))
For Each C In DeptRng
stringValues = stringValues & C
Next C
wksSource.Range(Cells(R, 2)).Value = stringValues
stringValues = ""
End If
.....several iterations of above here.....
Set rngStart = AllPos.Find("ID:").Cells
If Not rngStart Is Nothing Then
'Finds last row of content
lastRowCon = wksSource.Range("A1").End(xlDown).Row
'Finds first row without content
R = lastRowCon + 1
'select next empty row, Column B
End If

wksSource.Cells(R, 2).Value = stringValues
If it's a single cell, you don't need Range().
Edit: See this for further examples. If you give the Range property one parameter, it has to be the name of a Range. Cells(i,j) returns a Range object and you don't need/can't use Cells(i,j) as a name of itself. When you use Cells(i,j) it's like using ActiveSheet.Cells(i,j), btw.

Related

How can I test if a selection is completely within a range?

So i have found this which is similar:
VBA test if cell is in a range
but this seems to be testing (as I understand it) if the cells selected intersect the range at all. However I need to find a way to confirm if the selected range is COMPLETELY within the range so that I can restrict the macro to only work inside a specified range of cells.
here is what I've got so far....I name the selected cells as a range (sel_rng) and set them as a variable....then I name the acceptable range as a named range (okay_rng)....then (hopefully....but this is the part I'm still unclear how to pull off) if "sel_rng" lies completely within "okay_rng" I want to grab "sel_rng" and merge it, otherwise throw up an error"
Sub Merge_Cells()
'
' Merge_Cells Macro
Dim selcells As Range
Selection.Name = "sel_rng"
selcells = Range("sel_rng")
Dim okayrng As Integer
okayrng = Range("itemrows").Value + 28
ActiveSheet.Range("C29:C" & okayrng).Select
Selection.Name = "okay_rng"
Range("sel_rng").Select
Selection.Merge
Thoughts anyone?
The intersection of the two ranges will determine if one range is completely within another range.
dim rng1 as range, rng2 as range
set rng1 = range("b2:c3")
set rng2 = range("a1:d4")
'if rng1 is completely within rng2, the intersection's address will be the same as rng1's address
if application.intersect(rng1, rng2).address = rng1.address then
debug.print rng1.address(0, 0) & " is within " & rng2.address(0, 0)
end if
btw, there is the possibility that the intersect could be nothing. You should add error handling for that.

Copy specific cell to another worksheet

This has been driving me crazy and is something that should be easy, but I never touched vba before, so...
I have a for loop iterating on a row searching for matching occurrences, I know the loop is working because I can get an accurate count of the number of matching occurrences. Essentially "if month = month then counter=counter+1"
Whenever the loop finds a matching occurrence I need it to copy a specific cell (let's say AA22) to another worksheet, but I cant get it to work, it keeps throwing error codes with super broad and vague descriptions. I've tried a few of the solutions here and a few on other forums, nothing works correctly. Also, it seems every solution works with ranges, I need one that copies cells one by one.
Here's my code:
Dim chomonth As Integer
chomonth = InputBox("Insira o mes ", "Inserir dados")
Dim counter As Integer
Dim rng As Range
Dim rw As Range
Dim cell As Range
Set rng = Range("S3:S9999")
For Each rw In rng.Rows
If month(rw.row) = chomonth Then
//Code that copies AArw to worksheet 2 goes here
counter = counter + 1
End If
Next rw
MsgBox ("Numero de entradas:" & Count)
Try this:
If month(rw.row) = chomonth Then
counter = counter + 1
Worksheets("Sheet2").Cells(counter, 1).Value = Worksheets("Sheet1").Cells(rw.row, 27).Value
End If

VBA Range.Find method not finding a value that IS in the range

I have the following method which finds the largest and smallest values in a range. I am then using those values to locate the actual cell they are in as I need to grab the value from the header cell of that column. The Range.Find is always returning Nothing even though the range being searched HAS A CELL WITH THAT VALUE.
Sub GetTopAndBottomFiveCommodities()
Dim tempRange As Range, x As Integer, bestPnL As Double, worstPnL As Double
Dim strTopRangeName As String, strBottomRangeName As String
Dim cCell As Range, commodityName As String
Set tempRange = dataSourceSheet.Range("A:A").Find(What:="Year Totals")
Set tempRange = Range(tempRange.Offset(0, 1), tempRange.End(xlToRight).Offset(0, -1))
For x = 1 To 5
strTopRangeName = "TopCommodity" & CStr(x)
strBottomRangeName = "BottomCommodity" & CStr(x)
bestPnL = WorksheetFunction.Large(tempRange, x)
worstPnL = WorksheetFunction.Small(tempRange, x)
Debug.Print tempRange.Address
' get the top commodity name and PnL
**Set cCell = tempRange.Find(What:=bestPnL, LookIn:=xlValues)**
commodityName = dataSourceSheet.Cells(5, cCell.Column).Value
Range(strTopRangeName).Value = commodityName
Range(strTopRangeName).Offset(0, 1).Value = bestPnL
Next x
End Sub
The code line
Set cCell = tempRange.Find(What:=bestPnL, LookIn:=xlValues)
is always returning nothing but I have verified that there are cells with that value. One example, the cell value is 66,152.61 (displayed in cell as 66,153) and the bestPnL variable is 66,152.61 , so I tried rounding bestPnL to 66,153, but still didn't find it. The debug statement is showing tempRange has the right range, so its not searching in the wrong place.
The only thing I can think of is the cell with the value, gets its value from a very long formula, using over a dozen named ranges, can this be fouling the find method?
Just so we all know I'm not crazy, here is a snapshot of part of the range I'm searching where I'm testing.
EDIT
Based on Tim Williams suggestion, I changed the number format of the range being searched prior to the Find call.
tempRange.NumberFormat = "0.00"
and then the Find call works as it should. I then just put the number format back the way I want it at the end of the routine.
tempRange.NumberFormat = "$#,##0;[Red]$#,##0"
Works as expected now.
Try removing the thousand separator from the number format on the cells. When I did that in a test range it worked fine, but with the separator it failed to find the value.
Set f = rng.Find(what:=bestPnL, LookIn:=xlFormulas)
will work even with the thousand separator (EDIT: only works with hard-coded values; fails with formulas).
EDIT2: this worked for me with a thousands separator and using formulas for the values (EDIT3!: does not work with currency formatting).
Sub Tester()
Dim f As Range, v, rng As Range
Set rng = Range("C3:C21")
v = Application.Large(rng, 3)
v = Format(v, rng.Cells(1).NumberFormat)
Set f = rng.Find(what:=v, LookIn:=xlValues)
Debug.Print f.Address ' >> C19
End Sub
This is an old question, but I found an alternative that can be effective and simple in some situations:
dim idx as long, rng as range
set rng = someRange
idx = application.WorksheetFunction.Match(1234,rng,0)
This will return the relative position of the FIRST 1234 valued cell in the provided range, independently of the formatting. The last 0 means you use an exact match.

How to find the last cell in a column which is supposed to be blank but has spaces?

So I have data with around 20,000 records. I want to set the range such that only data from Row 2 to 20,000 is checked in column A. However, cell 20,001 isn't blank, it could contain spaces as well.
(This data is imported prior to validation, so I cannot alter it)
When I use .End(xlUp) it ends up checking till some 50,000th row.
Any Help?
Sample:
Column A
A
B
(2 spaces inserted)
I want to check for cells only till B(including it)
Update:
Managed to return the last required cell to the main sub
Private Sub last()
Dim rngX As Range
Set rngX = ActiveSheet.Range("A1").EntireColumn.Find(" ", lookat:=xlPart)
If Not rngX Is Nothing Then
/* return value
End If
End Sub
GD pnuts,
If you want to use VBA, you could contemplate checking for [space] character ? assuming the cell contains only spaces (or only one for that matter)
Something like:
Dim r as range
set r = range("B")
For each c in r.rows
if instr(1, c.value,chr(32)) > 0 then
'do something
end if
next
You could function a check of all characters in cell.value string to validate that they are only spaces ?
Does that help ?
I believe you will have to test each cell individually. To make the number of cells to check smaller, and to speed things up, I would first read the column to check into a Variant array, and then check that from bottom to top. I the spaces are truly a space, the test below will work. If the space is a NBSP, or a combination, then you will have to revise the check to ensure that is the only thing present.
e.g: to check column A:
Option Explicit
Sub foo()
Dim R As Range
Dim WS As Worksheet
Dim V As Variant
Dim I As Long
Set WS = Worksheets("sheet2")
With WS
V = .Range("a1", .Cells(.Rows.Count, "A").End(xlUp))
For I = UBound(V) To LBound(V) Step -1
'Revise this check line as needed
If Len(Trim(V(I, 1))) > 0 Then Exit For
Next I
Set R = .Cells(I, 1)
End With
Debug.Print R.Address
End Sub
You might want to add some error checking in case all of the cells are empty.

.End(xlDown) selecting last nonblank cell incorrectly

Writing VBA code to copy a dynamic range to a new worksheet. The code is supposed to first define a range which is the range to be copied. It does this by starting in the upper left hand corner of where the range will begin, then using Range.End(xlDown) to find the last entry. The offset then finds the bottom right hand corner of the range, and the range is set to span from the upper left hand corner to the lower right hand corner. That's how it is supposed to work, and how it does work for a verbatim sub, where the only changes are in the variable names for clarity.
Here's where it goes south. The Range.End(xlDown) is indicating that the last non-blank cell in the column is the very, very bottom cell on the worksheet (Like row 40,000 something). This is clearly not true, as the last non-blank cell is three rows down from the range I am looking at. Thus, rather than getting a 4x5 size range, I get one that spans nearly the entire height of the sheet. I have also tried clearing all the formatting of the column in case something was lingering, but to no avail. The code is below.
Sub Copy_Starters_ToMaster()
Dim MasterIO As Worksheet, IOws As Worksheet
Set MasterIO = Worksheets("Master IO Worksheet")
Set IOws = Worksheets("IO Worksheet")
'Sets a range to cover all VFDs entered for an enclosure.
Dim EnclosureStarters As Range, BottomLine As Range
Set BottomLine = IOws.Range("$Z$6").End(xlDown).Offset(0, 3)
Set EnclosureStarters = IOws.Range("$Z$6", BottomLine)
'Finds first blank line in Master VFD table
Dim myBlankLine As Range
Set myBlankLine = MasterIO.Range("$AB$6")
Do While myBlankLine <> vbNullString
Set myBlankLine = myBlankLine.Offset(1, 0)
Loop
'Copies over enclosure list of VFDs, pastes into the master at the bottom of the list.
EnclosureStarters.Copy
myBlankLine.PasteSpecial
Dim BottomInEnclosure As Range, currentStarterRange As Range, EnclosureNumber As Range
'Indicates which enclosure each VFD copied in belongs to, formats appropriately.
Set BottomInEnclosure = myBlankLine.End(xlDown)
Set currentStarterRange = Range(myBlankLine, BottomInEnclosure).Offset(0, -1)
For Each EnclosureNumber In currentStarterRange
With EnclosureNumber
.Value = Worksheets("Math Sheet").Range("$A$11").Value
.BorderAround _
ColorIndex:=1, Weight:=xlThin
.HorizontalAlignment = xlCenter
End With
Next EnclosureNumber
End Sub
Any advice on this would be much appreciated, it is endlessly frustrating. Please let me know if I need to post photos of the errors, or any further code, etc.
I think the answer here is to use xlUp and a generic lastrow formula such as:
Set BottomLine = IOws.Cells(Rows.Count, "Z").End(xlUp).Offset(0, 3)
That gives the last used cell in column Z, offset by 3
Cleaner again to use Find rather than rely on the xlUp type shortcuts, something like this (which also caters for the column being empty, which is a common error when setting ranges):
Dim rng1 As Range
Set rng1 = IOws.Range("Z:Z").Find("*", IOws.[z1], xlFormulas, , xlPrevious)
If Not rng1 Is Nothing Then Set Bottomline = rng1.Offset(0, 3)
`if rng1 is Nothing then the area searched is blank