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.
Related
I have two cells that are refusing to populate in row 10 and 70. Every other cell populates and I have tried changing columns, even workbooks but I still get the same problem. There is no protection or passwords. I have no idea of the cause. This is the very simple code it is running on these cells:
i = 1
Worksheets("Output").Range("N1") = i
For z = 2 To lastrow - 1
If Worksheets("Output").Range("D" & z).Value < Worksheets("Output").Range("D" & z - 1).Value Then
i = i + 1
Worksheets("Output").Range("N" & z).Value = i
End If
If Worksheets("Output").Range("D" & z).Value = Worksheets("Output").Range("D" & z - 1).Value Then
Worksheets("Output").Range("N" & z).Value = i & " (tie)"
Worksheets("Output").Range("N" & z - 1).Value = i & " (tie)"
End If
If Worksheets("Output").Range("D" & z).Value = "" Then
i = i + 1
Worksheets("Output").Range("N" & z).Value = i
End If
Next z
I cannot fathom out why it is happening, the trouble is it messes up my sequence. I have tried forcing it to populate if it is blank with those last 3 lines but still nothing.
The principle error in your code is that it contains a logical trap:-
If [Condition 1] Then i = i + 1
If [Condition 2] Then i = i + 1
This is contrary to the logic that every row defined by z needs a result. The trap is in that nothing will be counted if neither of the two conditions are met. Therefore you should structure your code as follows.
If [Condition 1] Then
i = i + 1
ElseIf [Condition 2] Then
i = i + 1
Else
i = i - 1
End If
In this way, using Else, it will be impossible to skip a row.
However, there are more logical flaws in your code. and once I set out to determine what might be in column D I came to a totally different structure which I share with you below.
Sub STO_66111404()
Dim i As Long ' rank
Dim Tie As Boolean ' next item is of same value
Dim Tied As Boolean ' last item was of same value
Dim R As Long ' loop counter: rows
With Worksheets("Output")
For R = 1 To .Cells(.Rows.Count, "D").End(xlUp).Row - 1
i = i + Abs(Not Tie) ' Abs(Not Tie) = 1 if Tie is False
' Val() converts any non-numeric value, incl "", to 0
Tied = Tie
Tie = Val(.Cells(R, "D").Value) = Val(.Cells(R + 1, "D").Value)
.Cells(R, "N").Value = i & IIf(Tie Or Tied, " (tie)", "")
Next R
.Cells(R, "N").Value = i + Abs(Not Tie) & IIf(Tie, " (tie)", "")
End With
End Sub
It may take you a moment to recognize this code as your own. So, here are a few points to guide you.
With Worksheets("Output") helps you avoid repeating the sheet name over and over again. In the code that follows this line, and until End With, the object is represented merely by a leading period. .Cells(.Rows.Count, "D") stands for Worksheets("Output").Cells(Worksheets("Output").Rows.Count, "D")
Ranges comprising of single cells are most efficiently addressed by the syntax designed for that purpose, to wit, by a cell's coordinates instead of its range name. So, .Cells(R, "D") stands for Range("D" & R). This syntax has the added advantage that it is also equal to .Cells(R, 4), meaning you can easily calculate both row and column numbers.
The big difference in the approach is that your code focuses on the conditions and therefore uses a lot of IFs. In the above approach the focus is on the results of the conditions, expressed in the two variables, Tie and Tied. Your code has no equivalent for the latter but doesn't seem to need it, either. Note, however, that the above code may not handle the case correctly where the next value in column D is smaller than the preceding. The code just checks for equality and presumes that the next value is bigger if it isn't equal, setting Tie = False here: Tie = Val(.Cells(R, "D").Value) = Val(.Cells(R + 1, "D").Value). In your approach, this may be the reason for the skipped lines.
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
At work I have a repetitive task of going through a list of account activity and changes where I have to delete blank spaces and lines that are not necessary for the maintenance I perform. For 80% of the these I am able to work a for each loop that is pretty inelegant but effective.
Example:
For Each c In ActiveSheet.UsedRange
If InStr(1, c.Value, SubString7) = 1 Then ' find earn lines and remove
c.EntireRow.Offset(1).Delete
c.EntireRow.Clear
c.EntireRow.Offset(-1).Delete
End If
Next
The substring is the descriptive title line for each type of transaction. The one I am having trouble with is variable, while the others are not. It can be 9 lines long or 6 lines long, and could also be positive or negative but each possibility comes with the same title line.
Based on everything I could find to try to figure it out, I need to use a loop, moving from bottom to top. I cannot get it to trigger with either InStr, nor left/right.
This is a cut down version of what I am trying now:
lr = Range("A" & Rows.Count).End(xlUp).Row
For rowcounter = lr To 0 Step -1
If VBA.Strings.Left(Cells(rowcounter).Value, 11) Like "Earn Manual" Then
If VBA.Strings.Left(Cells(rowcounter + 5).Value, 1) = "-" Then
If VBA.Strings.Left(Cells(rowcounter + 6).Value, 3) = "AVG" Then
Cells(rowcounter).EntireRow.Offset(5).Delete 'this, several more times with different offsets for the required lines
Else
Cells(rowcounter).EntireRow.Offset(5).Delete 'different ones, finalizing removals on the negative value items
End if
Else
If VBA.Strings.Left(Cells(rowcounter + 6).Value, 3) = "AVG" Then
Cells(rowcounter).EntireRow.Offset(5).Delete 'again, but with different offsets
Else 'There is one line for these that I have to split into two lines, not sure if this will even work as I cannot get it to trigger
Cells(rowcounter).EntireRow.Offset(8).Delete
Cells(rowcounter).EntireRow.Offset(7).Delete
Cells(rowcounter + 4).Value = VBA.Strings.Right(Cells(rowcounter + 3).Value, 25)
Cells(rowcounter + 3).Value = VBA.Strings.Left(Cells(rowcounter + 3).Value, 13)
End if
End If
End If
Next Rowcounter
I had originally had that first If line as:
If InStr(1, Cells(rowcounter).Value, SubString8) = 1 Then
I tried switching to Left() and Like but still no dice.
Attempting to provide sample of input/output
sample data:
Goal output from column A:
Retained Data
Update again, new and improved code that is still failing:
Next
For i = 1 To ActiveSheet.Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row
If ws.Range("A" & i) Like "Earn Manual*" Then
If ws.c("A" & i + 5) Like "-*" Then
If ws.c("A" & i + 6) Like "Avg*" Then
Set Deleteme = c.Range("A" & i, "A" & i + 8) ' shows AVG, negative value
Else
Set Deleteme = c.Range("A" & i, "A" & i + 5) ' no AVG, negative value
End If
Else
If ws.c("A" & i + 6) Like "Avg*" Then
Set Deleteme = c.Range("A" & i, "A" & i + 3)
Set Deleteme = c.Range("A" & i + 5)
Else
Set Deleteme = c.Range("A" & i, "A" & i + 3)
Set Deleteme = c.Range("A" & i + 5)
End If
End If
Else
Set Deleteme = Union(Deleteme, ws.Range("A" & i))
End If
Next A
There is no way that I can get this 100% correct because it was based of the OP's new and improve code, which has some flaws in its logic. My goal was to simply the overall syntax to make it easier to get right.
The problem with deletion with offset values is that the values move on you. My solution is to Union all rows to be deleted and delete them then after the loop is done. This is not only more efficient but it allows us to loop from top to bottom. This makes the code it much easier to follow.
When Union ranges in this way, you must first test to see if the target range to be deleted is Nothing. If the target range is Nothing, we Set it to the new range else we Union the two ranges. I wrote a subroutine UnionRange(), so that we would not have to repeat this process each time we needed to do a Union.
With blocks, Range.Offset() and Range.Resize() were used to simply the syntax. I feel like this is cleaner than concatenating addresses inside of a range (e.g. Range("A" & i + 5) and Range("A" & i, "A" & i + 8)).
Sub CleanUp()
With ThisWorkbook.Worksheets("Sheet1")
Dim r As Long
Dim rUnion As Range
For r = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
With .Cells(r, 1)
If .Value = "" Then
UnionRange rUnion, .Offset(0)
ElseIf .Value Like "Earn Manual*" Then
If .Offset(6).Value Like "Avg*" Then ' shows AVG, negative value
UnionRange rUnion, .Offset(8)
Else ' no AVG, negative value
UnionRange rUnion, .Offset(5)
End If
Else
'This can't be right
If .Offset(6).Value Like "Avg*" Then 'If Like "Avg*" Then Delete These Cells
UnionRange rUnion, .Resize(3)
UnionRange rUnion, .Offset(5)
Else 'Hell If Not Like "Avg*" Then Delete The Same Cells Anyway
UnionRange rUnion, .Resize(3)
UnionRange rUnion, .Offset(5)
End If
End If
End With
Next
End With
If Not rUnion Is Nothing Then
Application.ScreenUpdating = False
rUnion.EntireRow.Delete
End If
End Sub
Sub UnionRange(ByRef rUnion As Range, ByRef Cell As Range)
If rUnion Is Nothing Then
Set rUnion = Cell
Else
Set rUnion = Union(rUnion, Cell)
End If
End Sub
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
I have a simple macro which adds the contents of each row in an excel sheet to a text file, with delimiters in between each cell value. This is done by running a for loop which iterates through each row and at the end of each iteration the values are added to the end of a String variable.
Each ROW can have a lot of characters in it - I have not noticed any issues with that. However, when 1 single cell contains more than 255 characters, the concatenation fails. I am not sure if it is because of String limitations (I don't think that is the case), or if it is the Trim, Join, or Index functions that contains this limitation, or if it something else. Any help in getting some more insight would be appreciated.
The line in question ('R' refers to the row/iteration number):
stringVariable = stringVariable & vbNewLine & Application.Trim(Join(Application.Index(Cells(R, "A").Resize(, 25).Value, 1, 0), "|"))
The error is:
Run-time error '13': Type mismatch
The problem is with the Application.Index. How to debug?
Let's have the active sheet with any values in row 1, all with less than 255 chars. But in one of this cells in row 1, for example in C1, should be the formula:
=REPT("c",255)
Now split the code into parts:
Sub test()
r = 1
v2DArray = Cells(r, "A").Resize(, 25).Value
index1DArray = Application.Index(v2DArray, 1, 0)
joinString = Join(index1DArray, "|")
stringVariable = Application.Trim(joinString)
MsgBox stringVariable
End Sub
This will work until you change the formula to =REPT("c",256). Now it will fail at Application.Index.
Instead of the Application.Index you could do the following:
Sub test2()
r = 1
v2DArray = Cells(r, "A").Resize(, 25).Value
ReDim v1DArray(LBound(v2DArray, 2) To UBound(v2DArray, 2)) As String
For i = LBound(v2DArray, 2) To UBound(v2DArray, 2)
v1DArray(i) = v2DArray(1, i)
Next
joinString = Join(v1DArray, "|")
stringVariable = Application.Trim(joinString)
MsgBox stringVariable
End Sub
After experimenting using different combinations of the already present functions, I found that the macro finishes without issues when Index is not used.
In the end I decided to add the value of each cell to the end of the string, one at a time. Solution:
For i = 1 To numberOfColumns
If i < numberOfColumns Then
stringVariable = stringVariable & Trim(Cells(R, i).Value) & "|"
Else
stringVariable = stringVariable & Trim(Cells(R, i).Value)
End If
Next i
stringVariable = stringVariable & vbNewLine