I am trying to do left vlookup here. I understand that I have some values that cannot be found but I don't understand why is there still error of Application-defined or object defined error popping out in the middle of the loop. Thanks for your help in advance.
With Sheet3
x = 2
Do Until IsEmpty(.Range("E" & x).value)
look = .Range("E" & x).value
result = WorksheetFunction.Index(Sheet2.Range("A:A"),
WorksheetFunction.Match(look, Sheet2.Range("B:B"), 0))
If Not IsError(result) Then
.Range("F" & x).value = result
Else
.Range("F" & x).value = " "
End If
x = x + 1
Loop
End With
In VBA, the IsErrror function returns true if a Variant holds the vbError value. This value isn't assigned to the Result variable, even if it is a variant, when the error occurs in not finding the Match. You would have to capture that error using the On Error Goto ... method.
It isn't such a big deal. Your code might look like this.
Result = ""
On Error Resume Next
Result = WorksheetFunction.Index(Sheet2.Range("A:A"), _
WorksheetFunction.Match(look, Sheet2.Range("B:B"), 0))
.Range("F" & x).Value = Result
If an error results, the variable Result will retain the value it had before. Therefore it is set to "" before the function. So you don't need to test if there was an error.
In the process of writing this code I found that you had also missed the underscore at the line break of the Index function.
Would this array formula do the job?
=INDEX($B$1:$B$8,SMALL(IF($A$1:$A$8=$E$1,ROW($A$1:$A$8)),ROWS($G$1:$G1)))
it is on rows 1 to 8
Related
is there a way to handle an error in a loop
I use a match function to match a cottage with the right size and class as it is reserved. But if there is no cottage_size available, the match function returns an error, after which I want to upgrade the cottage(cottage_size=cottage_size+1) and search for a match again..
My question is how do i go back to the match function after the error and after I upgraded the size..
If som = 0 And iDklasse = class And iDpers = cottage_size Then
Set klasseKolom = cottagesheet.UsedRange.Columns(3)
Set SizeKolom = cottagesheet.UsedRange.Columns(2)
For k = 4 To 1 Step -1
For p = 2 To 12
cottageId = (Evaluate("MATCH(1,(" & klasseKolom.Address(External:=True) & "=" & zoekklasse & ")*(" & SizeKolom.Address(External:=True) & "=" & cottage_size & "),0)"))
If Not IsError(cottageId) Then
huisnr = cottageId
If Application.CountIf(validatorsheet.Range("B:B"), huisnr) = 0 Then 'cottage beschikbaarheid (gaat niet goed)
validatorsheet.Cells(iD, 2).Value = cottagesheet.Cells(cottageId, 1).Value 'invullen in validatorsheet
stay = Reservationsheet.Cells(iD, 3).Value
arrival_date = Reservationsheet.Cells(iD, 2).Value
For datumkolom = 2 To laatstekolom
If arrival_date = roostersheet.Cells(1, datumkolom).Value Then
'If Application.CountBlank(Range(roostersheet.Cells(huisnr, datumkolom), roostersheet.Cells(huisnr, datumkolom + stay - 1))) = Range(roostersheet.Cells(huisnr, datumkolom), roostersheet.Cells(huisnr, datumkolom + stay - 1)).Cells.Count Then
Range(roostersheet.Cells(huisnr, datumkolom), roostersheet.Cells(huisnr, datumkolom + stay - 1)).Value = Reservationsheet.Cells(iD, 1).Value
End If
'End If
Next datumkolom
End If
ElseIf IsError(cottageId) Then zoekklasse = zoekklasse + k And cottage_size = cottage_size + p And klasseKolom = klasseKolom + k And SizeKolom = SizeKolom + p
cottageId = (Evaluate("MATCH(1,(" & klasseKolom.Address(External:=True) & "=" & zoekklasse & ")*(" & SizeKolom.Address(External:=True) & "=" & cottage_size & "),0)"))
huisnr = cottageId 'indien er geen match is??
End If
Next p
Next k
thanks in advance
Normally to run worksheet functions you would use the WorksheetFunction API.
Early-bound, Application.WorksheetFunction.Match gives you compile-time validation and idiomatic VBA runtime errors in case of mismatch (i.e. you can handle a mismatch with an On Error statement).
Late-bound, Application.Match loses compile-time validation, but now you get a Variant/Error result instead of a VBA runtime error in case of mismatch.
Using the late-bound version, you would have to validate that the result is usable before you consume it. The IsError standard library function returns true given a Variant/Error argument, so here:
If IfError(cottageId) Then
'...
End If
Try changing it to:
If IsError(cottageId) Then
'...
End If
That makes your control flow look something like this:
For i = 1 To iterations
Dim result As Variant
result = Evaluate("complicated Excel formula string")
If Not IsError(result) Then
'TODO process valid result here
Exit For 'we're done, no need to keep looping
End If
Next
Consider heeding Darren's advice though: it does seem Range.Find could be a better tool here. Loop logic remains the same: last thing you want is to GoTo-jump and increment i until the counter overflows its data type - with a For loop you can cap the maximum number of attempts beyond which you just gotta admit that you didn't get a match for the given cottage_size; Range.Find/Range.FindNext have mechanisms that kind of already implement this for you.
I am trying to wring a code to automated categorization of natural and induced fractured by fracture type in a data sheet. I am trying to use an If Then function for fracture types that are known to be Induced fractures rather than naturally occurring ones. I have tried two different ways of getting this categorization to work for even a single type by I keep getting compiling errors and syntax errors. Is there a better way to go about this sort of problem?
Sub Simple_if()
If Range(G4, [G1004]) = "Twist" Then Range(I4, [I1004]) = "Induced"
End If
Also have tried
Dim G As Integer
For G = 4 To 1004
and
Dim I As Integer
For I = 4 To 1004
If Cells(G, 5).Value = "Twist" Then Cells(I, 5).Value = "Induced"
If some row on Column G = "Twist" then that same row on Column i will show Induced
Dim i as Long
For i = 4 to 1004
If Range("G" & i) = "Twist" Then Range("I" & i) = "Induced"
Next i
If you need to act on the negative result (I.E. your value does NOT equal "Twist") you will change to the block version of If statement.
Dim i as Long
For i = 4 to 1004
If Range("G" & i) = "Twist" Then
Range("I" & i) = "Induced"
Else
Range("I" & i) = "Something Else?"
End If
Next i
I wrote if condition which is shown below, it looks for value "Current Status:" in row A and copy B value from that row to other sheet, if not not found "0" is placed in a cell, it works fine. Sometimes value "Current Status:" might be in a different cell than A18, it might show up in the range from A16 to A20, how can I modify that code to find it within the range and copy corresponding value?
If ws.Range("A18") = "Current Status:" Then
.Range("V" & NewRow) = ws.Range("B18")
Else
.Range("V" & NewRow) = "0"
End If
Just put your code in a For loop... or use VLookup like Scotty suggested. It's basically the same thing. A For loop is more flexible but less optimized (VLookup is faster). They both run on the order of fractions of a μs/cell.
For Each c In Range("A16:A20")
If c.Value2 = "Current Status:" Then
.Range("V" & NewRow) = c.Offset(0, 1)
Exit For
Else
.Range("V" & NewRow) = "0"
End If
Next
If using a For loop, this is a little bit more code than what's above but a better structure...
'Define a value holder variable where it's scope makes sense
Dim NewValue As String
'... other code here ...
'Default: NewValue = ""
NewValue = ""
For Each c In Range("A16:A20")
If c.Value2 = "Current Status:" Then
NewValue = c.Offset(0, 1)
'Exit For is optional in this case. It matters if
'there are multiple matches... do you want first or last result?
Exit For
End If
Next
'Assign NewValue to cell
.Range("V" & NewRow) = NewValue
Use Vlookup:
.Range("V" & NewRow) = "0"
On Error Resume Next
.Range("V" & NewRow) = Application.WorksheetFunction.VLookup("Current Status:", ws.Range("A:B"), 2, False)
On Error GoTo 0
This will put 0 in the cell then try to replace it with the value returned from the vlookup. If "Current Status:" is not found in column A on ws then it will throw an error and be ignored leaving 0 in the cell.
If the value is found it will return the value in Column B and put that in place of the 0
I try to read cells from each row in excel and check if my cell contains value from my array.
Dim products As Variant
products = Array("MS-CHOPMAT-6", "MS-BOARDS-3", "MS-CHOP-LR")
Dim element As Variant
For x = 2 To LastRow
order_quantity = Range("$E$" & x).Value
item_price = Range("$F$" & x).Value
For Each element In products
If InStr(Range("$D$" & x), element) > 0 Then
Range("$H$" & x) = order_quantity * 3
Else: Range("$H$" & x) = "ERROR - " & order_quantity & element
End If
Next element
Next
Unfortunately the "element" in the loop is always last array(products) element. In this case "MS-CHOP-LR".
There is a "nice trick" to find if a String is inside an array, it's by using the Match function.
For instance, let's say your cell String is "MS-BOARDS-3", then using the Match function will return a numeric value.
If your cell String is "MS-ELSE", then using the Match function will return an error , since it's not found in your array. So, if you add to that an If IsError(Application.Match(Range("$D$" & x).Value, products, 0)) Then you can trap this scenario, and directly pop-up your MsgBox you wanted.
Code
Dim products As Variant
Dim element As Variant
' add an integer variable for the "Match" function
Dim ArrElementID As Integer
products = Array("MS-CHOPMAT-6", "MS-BOARDS-3", "MS-CHOP-LR")
For x = 2 To LastRow
order_quantity = Range("$E$" & x).Value
item_price = Range("$F$" & x).Value
' if value not found inside the array using the "MATCH" function
If IsError(Application.Match(Range("$D$" & x).Value, products, 0)) Then
Range("$H$" & x).Value = "ERROR - " & order_quantity & element
Else ' successful "MATCH" inside the array
Range("$H$" & x).Value = order_quantity * 3
End If
Next
1.
You can't use for each in an array. Use;
For i = LBound(products) to UBound(products)
... products(i) ...
Next i
Or make use of collections (google is your friend)
2.
The last line of your code should state
Next x
3.
LastRow might not always get you the right value. Use;
Cells(x,y).end(xlDown).row
If you know for sure you have a concatinae row, or
Cells(x,y).SpecialCells(xlLastCell).roW
To get the absolute last row in any range given from that cell. Note that in both cases if there aren't any values below that cell the very last row of the worksheet is returned (65k something for xls 2003 and 1M something for xlsx 2007+). There are other options to get the last row in a range but these two are my favorite ones.
4.
If else statement doesn't require double column (:) after else
It took me a few hours, but I think I have finally worked out what you are saying your problem is ... after your code runs, every cell in column H has either the value of order_quantity * 3 or it has a value of ERROR - xxxMS-CHOP-LR".
This occurs because you are going through every element in products, even after you find a match on either the first or second element, so the "error" message is displayed whenever the final element does not equal the product in that row.
I suggest you change your code as follows:
Dim products As Variant
products = Array("MS-CHOPMAT-6", "MS-BOARDS-3", "MS-CHOP-LR")
Dim element As Variant
Dim matched As Boolean
For x = 2 To LastRow
order_quantity = Range("$E$" & x).Value
item_price = Range("$F$" & x).Value
matched = False
For Each element In products
If InStr(Range("$D$" & x).Value, element) > 0 Then
Range("$H$" & x).Value = order_quantity * 3
matched = True
Exit For
End If
Next element
If Not matched Then
Range("$H$" & x) = "ERROR - " & Range("$D$" & x).Value & " - unknown product"
End If
Next
If I have completely misunderstood your issue, please update the question to give more information. (Perhaps add screen dumps of what the current code is producing and what you expect it to produce.)
Thank you very much for your quick answers.
I will use Shai Redo solution:
Dim products As Variant
LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
products = Array("MS-CHOPMAT-6", "MS-BOARDS-3", "MS-CHOP-LR")
'products = Array(Array("MS-CHOPMAT-6", 11), Array("MS-BOARDS-3", 12), Array("MS-CHOP-LR", 13))
For x = LastRow To 1 Step -1
order_quantity = Range("$E$" & x).Value
item_price = Range("$F$" & x).Value
' if value not found inside the array using the "MATCH" function
If IsError(Application.Match(Range("$D$" & x).Value, products, 0)) Then
Range("$H$" & x).Value = "ERROR - " & order_quantity
Else ' successful "MATCH" inside the array
Range("$H$" & x).Value = order_quantity * 3 & LastRow
End If
Next
It is ok for my one report but in another I need array in array something like this
products = Array(Array("MS-CHOPMAT-6", 11), Array("MS-BOARDS-3", 12), Array("MS-CHOP-LR", 13))
How to use such array in "match" where products are?
Regards
I have a range of data from A2:A34 with various names in it that I need to copy to the range E9:E14. I only need to copy and paste unique names (I don't need a double of the same name). I am pretty sure using a nested For Next loop is the way to go but I'm having trouble getting the outer loop to go to the next iteration. Right now this is only giving me the last name in the in range A2:A34 repeated in E9:14. I was looking into using Exit For but when I added that in the code, the outer loop iterated but then the inner loop started over at 2.
Any help with this would be greatly appreciated. Thanks!
Below is my code:
Sub FillTable()
Dim tableCount As Integer
Dim rowCount As Integer
For tableCount = 9 To 13
If Range("E" & tableCount).Value = "" Then
For rowCount = 2 To 34
If Range("E" & tableCount).Value = Range("A" & rowCount).Value Then
ElseIf Range("E" & tableCount).Value <> Range("A" & rowCount).Value Then
Range("E" & tableCount).Value = Range("A" & rowCount).Value
End If
Next rowCount
End If
Next tableCount
End Sub
I am not sure if VBA is really needed for this exact issue but hopefully the below code will help. I switched the loops so that you only iterate through the large list of names once and then you iterate through the second list checking for duplicates. I also added a variable so it would allow for more than 5 unique names (unlike when tablecount was 9 to 13).
Fair warning - this is a quick and easy solution. It is neither elegant nor optimized.
Sub FillTable()
Dim tableCount As Integer
Dim rowCount As Integer
Dim n As Integer
n = 0
For rowCount = 2 To 34
For tableCount = 9 To 9 + n
If Range("E" & tableCount).Value = Range("A" & rowCount).Value Then
' name already found, break out of loop
Exit For
ElseIf Range("E" & tableCount).Value = "" Then
Range("E" & tableCount).Value = Range("A" & rowCount).Value
n = n + 1
End If
Next tableCount
Next rowCount
End Sub
It seems that your description of your goal does not match the code.
You are copying from (to simplify a bit) col A to col E.
Does col E already contain data? If not, why the first "if" stmt to see if some cell is empty?
If yes, E already contains data, then you want to loop through E to see if E already contains the new name.
I'll also point out that E has room (per your spec) for 6 names, while the source has 33 names.
Without knowing your goal, I won't suggest real code, but, perhaps a way of approaching the problem:
Create functions that do only very simple little things. For example, perhaps simplest, a function to see if name already in list. Note that I assume a value for highest used row, be sure to define it, whether as 14, or as some counter.
Function Is_Name_Already_Present_in_E( Name-to-check as String ) As Bool
Is_Name_Already_Present_in_E = False ; Default we'll return if don't find name.
for r = 9 to highest-so-far-used
if Name-to-check = Range( "E" & r ).value then ; If found name in list,
Is_Name_Already_Present_in_E = true ; then return true.
exit function
end if
next r
end function ; If scan whole list, and not found,false.
I'm sure there are a few syntax errors, but they should be easy to resolve.
Then, create a simple function to add your new name to E. Perhaps something like (Beware the assumptions!):
Function Add_New_Name_To_List( Name as string ) as bool
if highest_used_so_far >= 14 then
Error "No room to insert name:" & Name & ". Rejected."
Add_New_Name_To_List = false
exit function
end if
highest_used_so_far = highest_used_so_far + 1
range( A & h_u_s_r ).value = Name
Add_New_Name_To_List = true
exit function
Then, your main becomes a very simple (fake code example because I don't know your intent):
for r = 2 to 34
if not Is_Name_Already_Present_in_E( range( "A" & r ).value ) then
if not Add_Name_to_E( range( "A" & r ).value ) then
... what to do if add fails. ...
end if
end if
next name
Break your problem into pieces and it should be clear how to write each piece. Good luck.