For each range including a variable-problem - vba

I have a problem in a small part of my code : I want it to select the cells starting from c which is a cell meeting a condition that I have defined earlier, to the end of the list. In this range, I want it to copy the first value that exceeds resultat (a value obtained before).
With Worksheets("Feuil1").Range("A2:A5181")
Set c = .Find(Worksheets("Feuil2").Range("A14").Value, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Range(Range(c), Range(c).End(xlDown)).Select
If c Is Nothing Then
GoTo DoneFinding
End If
Loop While c.Address <> firstAddress
End If
DoneFinding:
End With
Dim c As Range
Dim firstAddress As String
Dim resultat As Double
Dim Cel As Range
Dim firstValue As Integer
Dim s1 As String, s2 As String
s1 = Worksheets("Feuil2").Range(c)
s2 = Worksheets("Feuil1").Range(s1).End(xlDown)
Worksheets("Feuil1").Range(s1 & ":" & s2).Select
For Each Cel In Range(s1 & ":" & s2)
If Cel.Value >= resultat Then
firstValue = Cel.Value
firstAddress = Cel.Address
Exit For
End If
Next
Worksheets("Feuil1").firstValue.Copy
Range("C14").Worksheet("Feuil2").PasteSpecial
I get an error for the 2 first lines of the code.
Thanks a lot for your help.
This is my new code, because I realized something is missing.. The SearchRange does not start from row 2, but from the row where the value (a date) is equal to the last date of ws2. I get an error for my For each line. It says Object required.
Edit - New code, object error at rangyrange :
Private Sub CommandButton1_Click()
Dim rangyrange As Range
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim foundRange As Range
Dim searchRange As Range
Dim lastRow As Long
Dim ws1Cell As Range
Dim firstAddress As String
Dim Cel As Range
Dim firstValue As Double
Dim A15Value As Date
Dim firsty As Long
Dim newRange As Range
Dim lastRow2 As Long
Set ws1 = Excel.Application.ThisWorkbook.Worksheets("Feuil1")
Set ws2 = Excel.Application.ThisWorkbook.Worksheets("Feuil2")
A15Value = CDate(ws2.Cells(15, 1).Value)
With ws1
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
lastRow2 = .Cells(.Rows.Count, 2).End(xlUp).Row
Set foundRange = ws1.Range(.Cells(2, 1), .Cells(lastRow, 1))
Set searchRange = foundRange.Find(A15Value, LookIn:=xlValues)
Set rangyrange = ws1.Range(.Cells(searchRange.Row, 1), .Cells(lastRow, 1))
firsty = rangyrange.Rows(1).Row
Set newRange = ws1.Range(.Cells(firsty, 2), .Cells(lastRow2, 2))
End With
For Each ws1Cell In newRange
If ws1Cell.Value >= resultat Then
firstValue = ws1Cell.Value
firstAddress = ws1Cell.Address
Exit For
End If
Next
ws2.Cells(15, 3).Value = firstValue
End Sub

Dim c As Range
Worksheets("Feuil1").Range(Worksheets("Feuil1").Range(c), Worksheets("Feuil1").Range(c).End(xlDown))
You haven't set c to a range, so VBA doesn't understand what you're doing.
Also, I suggest defining a worksheet variable to increase the readability of your code like this:
Set ws = Excel.Application.Worksheets("Feuil1")
And your statement becomes much more legible:
ws.Range(ws.Range(c), ws.Range(c).End(xlDown))
This is not how you reference a range, also, I would suggest never using .Select.
Range(s1 & ":" & s2).Select
This is how you reference a range:
'this is my preferred method of referencing a range
Set someVariable = ws.Range(ws.Cells(row, column), ws.Cells(row, column))
Or...
'this is useful in some instances, but this basically selects a cell
Set someVariable = ws.Range("B2")
Or...
'this references the range A1 to B1
Set someVariable = ws.Range("A1:B1")
Also, as #BigBen pointed out, you cannot set a range like so:
Dim c As Range
s1 = Worksheets("Feuil2").Range(c)
The reasons being:
c hasn't been assigned.
You can't use a range as an input unless it's of the form ws.Range(ws.Cells(row, column), ws.Cells(row, column))
Per your update that includes the assignment for c:
I get an error for the 2 first lines of the code.
This is because you're assigning c before you're declaring c.
You should have all of your Dim statements preceding your actual code (unless you know what you're doing) like so:
Public Sub MySub()
Dim c As Range
Dim firstAddress As String
Dim resultat As Double
Dim Cel As Range
Dim firstValue As Integer
Dim s1 As String, s2 As String
`the rest of your code
End Sub
I would change your Do loop to the following:
With Worksheets("Feuil1").Range("A2:A5181")
Set c = .Find(Worksheets("Feuil2").Range("A14").Value, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do While c.Address <> firstAddress
'I'm unsure of the goal here, so I'm ignoring it
Range(Range(c), Range(c).End(xlDown)).Select
If c Is Nothing Then
Exit Do
End If
Loop
End If
End With
Mainly because I hate GoTo statements and because the MS doc for Do loops states to use either Do While or Do Until instead of Loop While or Loop Until
s1 and s2 are strings, so you can't do this:
s1 = Worksheets("Feuil2").Range(c)
s2 = Worksheets("Feuil1").Range(s1).End(xlDown)
I'm assuming you want to get the column and row of c and iterate through that, but the problem is that you're working in 2 different worksheets, which you can't do. I'll assume it's an error and that you want to work on the "Fueil2" worksheet, so here goes:
Dim ws2 As Worksheet
Dim startCell As Range
Dim endCell As Range
Dim foundRange As Range
Set ws2 = Excel.Application.ThisWorkbook.Worksheets("Fueil2")
With ws2
Set startCell = .Cells(c.Row, c.Column)
Set endCell = .Cells(c.End(xlUp).Row, c.Column)
Set foundRange = .Range(.Cells(c.Row, c.Column), .Cells(c.End(xlUp).Row, c.Column))
For Each Cel In foundRange
'yada yada yada
End With
Post-lunch Edit:
It seems that this is a bit misleading because I tested this snippet and it works:
Public Sub test()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim foundRange As Range
Dim searchRange As Range
Dim workRange As Range
Dim foundColumn As Range
Dim ws1LastCell As Range
Dim ws1Range As Range
Dim iWantThis As Range
Set ws1 = Excel.Application.ThisWorkbook.Worksheets("Sheet1")
Set ws2 = Excel.Application.ThisWorkbook.Worksheets("Sheet2")
Set searchRange = ws1.Range("A1:F1")
Set foundRange = searchRange.Find(ws2.Range("C1").Value, LookIn:=xlValues)
With foundRange
'last cell in the ws1 column that's the same column as foundRange
Set ws1LastCell = ws1.Range(ws1.Cells(.Row, .Column), ws1.Cells(ws1.Rows.Count, .Column)).End(xlDown)
'the range you want
Set iWantThis = ws1.Range(foundRange, ws1LastCell)
'check to see if it got what i wanted on ws1
iWantThis.Select
End With
End Sub
New Edit:
Public Sub test()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim c14Value As Double
Dim searchRange As Range
Dim lastRow As Long
Dim ws1Cell As Range
Set ws1 = Excel.Application.ThisWorkbook.Worksheets("Sheet1")
Set ws2 = Excel.Application.ThisWorkbook.Worksheets("Sheet2")
'gets the date
A14Value = CDate(ws2.Cells(14, 1).Value)
With ws1
'gets the last row's number in column A on worksheet 1
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
'selects from A2 to the last row with data in it. this works only if
'there aren't any empty rows between your data, and that's what i'm assuming.
Set searchRange = .Range(.Cells(2, 1), .Cells(lastRow, 1))
End With
For Each ws1Cell In searchRange
If CDate(ws1Cell.Value) >= A14Value Then
'i didnt make a variable for firstValue
firstValue = ws1Cell.Value
'i didnt make a variable for firstAddress
firstAddress = ws1Cell.Address
Exit For
End If
Next
'puts firstValue into cell C14 on ws2
ws2.Cells(14, 3).Value = firstValue
End Sub
Until I see a definition for resultat, I'm assuming it's 100% correctly declared and assigned. hint: You should give us your declaration and assignment of resultat because I can't fully determine if how you defined resultat is an issue.

Related

How to make an noncontiguous range of cells work for every cell referenced

I have a noncontiguous range and I want whatever the user writes in each cell in the range to show up in a column in a table I made. In the first column of my table I'm having the program number each generated entry in the table when the user adds a value in one of the specified cells all the way up to 18. I renamed each cell in the range to be "Space_ (some number)". Even though I have written in three of the specified cells, my table only shows me the first value in the first specified cell.
Here is my code so far:
Sub test2()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Sheets("Sheet1")
Dim i As Integer
Dim rng As Range
Set rng = ws.Range("Space_7, Space_10, Space_13, Space_16, Space_19, Space_22, Space_25, Space_28, Space_31, Space_34, Space_37, Space_40, Space_53, Space_56, Space_59, Space_62, Space_65, Space_68")
ws.Range("A13:A31,B13:B31").ClearContents
For i = 1 To 18
If Not IsEmpty("rng") Then
ws.Range("A12").Offset(1).Value = i
End If
Exit For
Next i
If Not IsEmpty("rng") Then
ws.Range("B12").Offset(1).Value = rng.Value
End If
End Sub
This should address the various issues I mentioned in my comment:
Sub test2()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Sheets("Sheet1")
Dim i As Long
Dim rng As Range, r As Range
With ws
Set rng = .Range("Space_7, Space_10, Space_13, Space_16, Space_19, Space_22, Space_25, Space_28, Space_31, Space_34, Space_37, Space_40, Space_53, Space_56, Space_59, Space_62, Space_65, Space_68")
.Range("A13:B31").ClearContents
For Each r In rng.Areas
If Not IsEmpty(r) Then
.Range("A13").Offset(i).Value = i + 1
.Range("B13").Offset(i).Value = r.Value
i = i + 1
End If
Next r
End With
End Sub
A couple things here - Instead of trying to put all your named ranges into a Range, put them individually in an Array and cycle through them - If they're not blank, put the value into the cell.
Your .Offset is always going 1 below row 12, so that's why you're only seeing one row of data.
Sub test2()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Sheets("Sheet1")
Dim i As Long, j As Long
Dim rngarray As Variant
rngarray = Array("Space_7", "Space_10", "Space_13", "Space_16", "Space_19", "Space_22", "Space_25", "Space_28", "Space_31", "Space_34", "Space_37", "Space_40", "Space_53", "Space_56", "Space_59", "Space_62", "Space_65", "Space_68")
j = 12
ws.Range("A13:B31").ClearContents
For i = 0 To UBound(rngarray)
If ws.Range(rngarray(i)).Value <> "" Then
ws.Range("A12").Offset(j - 11).Value = i + 1
ws.Range("B12").Offset(j - 11).Value = ws.Range(rngarray(i)).Value
j = j + 1
End If
Next i
End Sub
I'd go as follows:
Sub test2()
Dim i As Integer
Dim rng As Range, cell As Range
With ThisWorkbook.Sheets("Sheet1")
.Range("A13:A31,B13:B31").ClearContents
Set rng = .Range("Space_7, Space_10, Space_13, Space_16, Space_19, Space_22, Space_25, Space_28, Space_31, Space_34, Space_37, Space_40, Space_53, Space_56, Space_59, Space_62, Space_65, Space_68")
For Each cell In rng.SpecialCells(xlCellTypeConstants).Areas
ws.Range("A12:B12").Offset(i).Value = Array(i + 1, cell(1, 1).Value)
i = i + 1
Next
End With
End Sub

Selecting the last used cell in column A and then extend it to column H

Hi there I am trying to select a range "A2:H2" down to the last filled cell based on column A (so in this case it should select "A2:H59"). The range is not fixed so it cannot be defined with exact numbers. I have the following code, but it selects everything down to the 402nd row even though there is no data beyond "A59" in the sheet. Any idea what is going on? Thanks for the help!
Global ssaw As Worksheet
Global trckr As Worksheet
Sub DataF()
Dim myRange As Range
Dim myCell As Range
Set ssaw = Sheets("SSAW_DATA")
Set trckr = Sheets("SQL_DATA_FEED")
Set myRange = trckr.Range("A2:H2").end(xlDown)
With myRange
.SpecialCells(xlCellTypeBlanks).Interior.Color = RGB(255, 102, 102)
.SpecialCells(xlCellTypeBlanks).Value = "#missing#"
End With
End Sub
If we assume your last used cell in column A is A59 then …
… This
Set myRange = trckr.Range("A2", trckr.Range("A2").End(xlDown))
will select A2:A59 and this
.Resize(ColumnSize:=8)
will resize it to make it 8 columns width that is A2:H59.
So together we get:
Set myRange = trckr.Range("A2", trckr.Range("A2").End(xlDown)).Resize(ColumnSize:=8)
Use this
trckr.Range("A" & trckr.Rows.Count).End(xlUp)
alternatively to find the last used cell in column A if there can be empty cells in between:
Set myRange = trckr.Range("A2", trckr.Range("A" & trckr.Rows.Count).End(xlUp)).Resize(ColumnSize:=8)
exploit the fact that Range(cell1, cell2) is equivalent to Range(cell2, cell1)
Set myRange = trckr.Range("H2", trckr.Range("A2").End(xlDown))
while if you want to select a range from A2:H2 down to column A last not empty cell (i.e. included empty cells along column A in between the first and last not empty ones):
Set myRange = trckr.Range("H2", trckr.Cells(trckr.Rows.Count, 1).End(xlUp))
I would suggest to use the following code
Option Explicit
Function LastRowInColumn(colName As String)
Dim lastRow As Long
With ActiveSheet
lastRow = .Cells(.Rows.Count, colName).End(xlUp).Row
End With
LastRowInColumn = lastRow
End Function
Sub SelectRg()
Dim rg As Range
Dim wks As Worksheet
Dim lastRow As Long
lastRow = LastRowInColumn("A")
Debug.Print lastRow
If lastRow = 1 Then
' do nothing
Else
Set wks = ActiveSheet
With wks
Set rg = Range(.Cells(2, 1), .Cells(lastRow, "H"))
rg.Select
End With
End If
End Sub
The code determins the last filled row in column A and select based on this information everything to column H
EDIT Improved function
Function LastRowInColumn(ByVal wks As Worksheet, ByVal colName As String) As Long
With wks
LastRowInColumn = .Cells(.Rows.Count, colName).End(xlUp).Row
End With
End Function
EDIT2 And if one would not like to use an extra function you could do it like that
Sub SetRg()
Dim rg As Range
Dim wks As Worksheet
Dim lastRow As Long
Set wks = ActiveSheet
With wks
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'lastRow = LastRowInColumn(wks, "A")
If lastRow > 1 Then
Set rg = Range(.Cells(2, 1), .Cells(lastRow, "H"))
End If
End With
End Sub

Using (Nested Loop) .find to grab identical values seperate sheets VBA EXCEL

I have the following code which loops through two different worksheets and compares column A to column A checking if the same value is on the other sheet. If it is then the row is colored in green.
Dim compareRange As Range
Dim toCompare As Range
Dim rFound As Range
Dim cel As Range
Set compareRange = Worksheets("sheet2").Range("A1:A" & Lastrow3)
Set toCompare = Worksheets("sheet3").Range("A1:A" & Lastrow4)
Set rFound = Nothing
For Each cel In toCompare
Set rFound = compareRange.Find(cel)
If Not rFound Is Nothing Then
cel.EntireRow.Interior.Color = 5296274
Set rFound = Nothing
End If
Next cel
Now that I have the cell with the row how do I grab the cells from the same row but on different column? because now I want to check if column L from sheet2 matches column L from sheet3. If it doesn't I want to be grab that value from sheet2 and put it in a new row below on in the same column L. Any guidance or help would be appreciated.
This should help demostrate how to do what youre after
Private Sub compAre()
Application.ScreenUpdating = False
Dim sht1 As Range
Dim rcell As Range
Set sht1 = ThisWorkbook.Sheets("Sheet1").Range("A1:A3")
For Each rcell In sht1.Cells
If rcell.Value = ThisWorkbook.Sheets("Sheet2").Range("L" & rcell.Row).Value Then
sht1.Rows.Interior.Color = vbBlue
End If
Next rcell
Application.ScreenUpdating = True
End Sub
Here's some code that covers most of what you describe, coloring the cells that match and putting those into column L of the 3rd sheet. I didn't understand the remainder of the question after that, but this should give you a good start. The animation starts by showing the contents of sheets 1,2,3 and then shows those sheets again after running the macro.
Option Explicit
Sub test()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, num As Integer
Dim r1 As Range, r2 As Range, r3 As Range, cell1 As Range, cell2 As Range
Set sh1 = Worksheets("1")
Set sh2 = Worksheets("2")
Set sh3 = Worksheets("3")
Set r1 = Range(sh1.Range("A1"), sh1.Range("A1").End(xlDown))
Set r2 = Range(sh2.Range("A1"), sh2.Range("A1").End(xlDown))
Set r3 = sh3.Range("L1")
For Each cell1 In r1
For Each cell2 In r2
If cell1 = cell2 Then
cell1.Interior.Color = vbGreen
cell2.Interior.Color = vbGreen
r3 = cell1.Value
Set r3 = r3.Offset(1, 0)
num = num + 1
End If
Next
Next
MsgBox (num & " were found to match")
End Sub

VBA - How to loop

I'm pretty new into this and I got stuck.
If I have a text string in column A (A1:A10) let's say. And I have a macro that looks for a keyword in that string, if it's found I want a word to be entered into column B (B1:B10).
For example A1-Pizza Hut - B1 Pizza, A2 Burger King - B2 Burger.
I got to the point where I can find the keyword, but when I try to do anything that would loop through the range, I always end up getting the same result in B.
Thank you for the answers. I thought I posted my code, but I guess it didn't. Anyways I figured out a way after looking online for the whole day.
Sub one()
Dim food As String, type As String
Dim rng As Range
Dim cel As Range
Set rng = Range("A:A")
For Each cel In rng
food = cel.Value
If InStr(UCase(food), UCase("pizza")) <> 0 Then
type = "Fast food"
Elseif InStr(UCase(food), UCase("burger")) <> 0 Then
type = "Fast food"
Else
type = "Not Fast food"
End If
cel.offset (0, 1).Value = type
Next cel
End Sub
Use a For Each Loop & Split:
Option Explicit
Public Sub Example()
Dim Sht As Worksheet
Dim rng As Range
Set Sht = ActiveWorkbook.Sheets("Sheet2")
For Each rng In Sht.Range("A1", Range("A11").End(xlUp))
rng.Offset(0, 1).Value = Split(rng, " ")(0)
Next
Set Sht = Nothing
Set rng = Nothing
End Sub
This should do what you want:
Sub Find_and_Copy():
Dim keywords() As Variant
keywords = Array("Pizza", "Burger", "Chicken")
Dim endRow As Integer
Dim SearchRng As Range
With Sheets("Sheet1")
endRow = .Cells(Rows.Count, "A").End(xlUp).Row
Set SearchRng = .Range("A1:A" & endRow).Cells
End With
Dim r As Range
Dim firstAddress As String
Dim i As Integer
For i = 0 To UBound(keywords):
With SearchRng
Set r = .Find(keywords(i), LookIn:=xlValues)
If Not r Is Nothing Then
firstAddress = r.Address
Do
Cells(r.Row, "B").Value = keywords(i)
Set r = .FindNext(r)
Loop While Not r Is Nothing And r.Address <> firstAddress
End If
End With
Next
End Sub
It will find all occurrences of each entry in the 'keywords' array that matches cells of column "A" - and of course, set column "B" to that keyword.
Note that say you have an entry like "ala Burger Chicken" it'll put 'Chicken' (which I added to 'keywords' just to keep in the spirit of things) in column B for that row because that's the last thing it did a search for - hence overwriting the previous 'Burger' entry that was in that cell.

How do I use Loop with Variable Range

In the following code, when I get to for each curCell in Range(i) it is not able to understand the Range that I am referencing. I receive a Method 'Range' of Object'_worksheet' failed. I know the current Range(i) is incorrect, but I have tried every variation and nothing seems to work.
Can someone please help me understand how to get my code to recognize Range1, then Range2, etc?
Sub Worksheet_Change(ByVal Target As Range)
Dim Range1 As Range, Range2 As Range, Range3 As Range, Range4 As Range
Dim curCell As Variant
Dim i As Integer
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets(cCostingQSheet)
Set Range1 = ws.Range("E6:E9")
Set Range2 = ws.Range("E15:E19")
Set Range3 = ws.Range("E21")
Set Range4 = ws.Range("E23")
For i = 1 To 4
For Each curCell In Range(i).Cells
If Not WorksheetFunction.IsNumber(curCell) = True Then
curCell.Value = 0
Else
End If
Next
Next
End Sub
You need to use an array if you want a setup like that. Here's how:
Replace your variable declaration statement
'Instead of your original
'Dim Range1 As Range, Range2 As Range, Range3 As Range, Range4 As Range
'Use this:
Dim arrRanges(1 To 4) As Range
Then change how you set the ranges:
Set arrRanges(1) = ws.Range("E6:E9")
Set arrRanges(2) = ws.Range("E15:E19")
Set arrRanges(3) = ws.Range("E21")
Set arrRanges(4) = ws.Range("E23")
And when you loop through them, it looks like this:
For Each curCell In arrRanges(i).Cells
You could assign an non-contiguous range to a range variable instead of using either 4 different range variables or an array of ranges (as #tigeravatar suggested in their excellent answer). Something like this:
Sub test()
Dim R As Range
Dim myCell As Range
Dim ws As Worksheet
Dim i As Long
Set ws = ActiveSheet
Set R = ws.Range("E6:E9,E15:E19,E21,E23")
i = 1
For Each myCell In R.Cells
myCell.Value = i
i = i + 1
Next myCell
End Sub
I would go a step further and
Look at each range inside the overall range.
use a variant array to process the range (where the range area is more than one cell), then dump back to the range.
code
Sub recut()
Dim rng1 As Range
Dim rng2 As Range
Dim lngCol As Long
Dim lngRow As Long
Dim ws As Worksheet
Set ws = ActiveSheet
Set rng1 = ws.Range("E6:E9,E15:E19,E21,E23")
For Each rng2 In rng1.Areas
If rng2.Cells.Count > 1 Then
x = rng2.Value
For lngRow = 1 To UBound(x)
For lngCol = 1 To UBound(x, 2)
If IsNumeric(x(lngRow, lngCol)) Then x(lngRow, lngCol) = 0
Next
Next
rng2.Value2 = x
Else
If IsNumeric(rng2.Value) Then rng2.Value = 0
End If
Next rng2
End Sub