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
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.
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 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 32.000 rows with data. Some data are in a different place and I want to join them with something that I can apply to all rows and not manually. Each "group" have the same ID, in this example is "XPTO"
I have something like this now (but with more columns):
I want it to be like this:
The problem is that I need a clever way, because they are not always exactly like this example. Some of them have 10 rows with the same ID "XPTO" (example)
I am struggling with this =/ ty
Here's how I would approach this.
1) From your comment, I understand that the logic is positional (the first one on the left (Casteloes de) goes with the first one on the right (R Dr Antonio) for the matching value in column A. If that is true, then I would insert a column where you start numbering sequentially, then Fill Down to get sequential numbers all the way to the end. This will help preserve the positional logic if you need to sort or rearrange your data. It will also help you with the logic of "first match", "second match", etc.
2) My next step would be to separate the two sets of data into separate tables/tabs (with the sequentially numbered column appearing in each) and use INDEX/MATCH. The recent answer here will help you with how to increment the match: Is there such thing as a VLOOKUP that recognises repeated numbers?
3) Alternative - this may even be easier, although you'll want to do extensive data checking to make sure nothing got screwed up. With the two tables from step 2, sort by any column with data in it, then delete the blank rows from each table. Then, sort each by the sequentially numbered column to return to the original order. At that point you may be able to just copy and paste. Check carefully for errors if you do this.
I am positive that the solution above given by CriketBird work, at least it has a good logic to solve it, but since I am a newbie in excel, I couldn't figure it out how to solve it that way.
So I solved it by using VBA in excel...(maybe I went too far for this simple problem, but it was my only option).
I will leave the code here if someone want it for a similar situation. (just select the first column and row your table starts and hit run)
Function Area(medico As String) As Integer
Do While countOk < 1
If medico = ActiveCell.Value Then
ActiveCell.Offset(1, 0).Select
rowCount = rowCount + 1
Else: countOk = 1
End If
Loop
Area = rowCount
End Function
Sub Teste()
Dim PaginaMedico As String
Dim totalrowCount As Integer
Dim rowCount As Integer
Dim countOk As Integer
Dim right As Integer
Dim left As Integer
Dim listaleft As New Collection
Dim listaright As New Collection
rowCount = 1
rowOk = 0
totalrowCount = 0
right = 0
left = 0
Do While ActiveCell.Value <> 0
PaginaMedico = ActiveCell.Value
rowCount = Area(PaginaMedico)
totalrowCount = totalrowCount + rowCount
Range("A" & (totalrowCount - (rowCount - 1))).Select
For i = ((totalrowCount + 1) - rowCount) To totalrowCount
If IsEmpty(Range("E" & (i)).Value) And IsEmpty(Range("F" & (i)).Value) Then
Range("T" & (i)).Value = "Empty"
ElseIf Not IsEmpty(Range("E" & (i)).Value) And Not IsEmpty(Range("F" & (i)).Value) Then
Range("T" & (i)).Value = "Full"
ElseIf Not IsEmpty(Range("E" & (i)).Value) And IsEmpty(Range("F" & (i)).Value) Then
left = left + 1
listaleft.Add i
ElseIf IsEmpty(Range("E" & (i)).Value) And Not IsEmpty(Range("F" & (i)).Value) Then
right = right + 1
listaright.Add i
End If
Next i
If Not (right = left) Then
Range("T" & totalrowCount).Value = "BOSTA"
right = 0
left = 0
End If
If listaleft.Count = listaright.Count Then
For i = 1 To listaleft.Count
Range("F" & listaright(1) & ":" & "S" & listaright(1)).Cut Range("F" & listaleft(1) & ":" & "S" & listaleft(1))
listaright.Remove (1)
listaleft.Remove (1)
Next i
End If
Set listaleft = New Collection
Set listaright = New Collection
Range("A" & (totalrowCount + 1)).Select
Loop
End Sub
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.