Loop and IF formula for 0.00% - vba

Can someone help me with the below code?
I am trying to add a text "Valid" in Column "I" if Cells in Column E is not Blank and Column H is 0.00%. Column H is converted to Format Cells>Percentage>Decimal Places = 2.
I am getting the error message:
Runtime error "13": Type Mismatch.
in the line:
If (Range("E" & Y) <> "" And Range("H" & Y) = "0.00%" Then)
The full code is:
Sub My_Comments()
Dim X As Integer
Dim Y As Integer
Dim Z As Integer
For X = 2 To 10000
If IsError(Range("F" & X)) Then
Range("I" & X) = "Not Held"
End If
Next X
For Y = 2 To 10000
If Range("E" & Y) <> "" And Range("H" & Y) = "0.00%" Then
Range("I" & Y) = "Valid"
End If
Next Y
End Sub

You need to change the line
If Range("E" & Y) <> "" And Range("H" & Y) = "0.00%" Then)
with this:
If CStr(Range("E" & Y)) <> "" And Range("H" & Y).Text = "0.00%" Then '// .Text

Related

For loop with formulas

I have this code below which I want to be used in a loop. However, instead of C5 and D5, I would want this loop to be run on all the cells in column C and column D and not only for C5 and D5.
To summarize, I would want C5 and D5 to be replaced by every cell in Column C and D. Please assist.
For i = 1 To 5
Valuex = Evaluate("=IsNumber(Value(Mid(C5, 2, 1)))")
MsgBox (Valuex)
Valuex1 = Evaluate("=Left(Trim(C5), 1) = ""R""")
MsgBox (Valuex1)
If ((Evaluate("=Left(Trim(C5), 1) = ""R""") = "True") And (Evaluate("=IsNumber(Value(Mid(C5, 2, 1)))") = "True")) Then
Range("D5").Formula = "=VLOOKUP(C5,[old.xls]Sheet1!$D:$V,19,0)"
MsgBox ("if")
Else
Range("D5").Formula = "=VLOOKUP(C5,[old.xls]Sheet1!$E:$V,18,0)"
MsgBox ("else")
End If
Next i
Think this does what you want. It will run from row 1 to the last row in C. Note that you could do all this without VBA.
Sub x()
Dim i As Long, Valuex As Boolean, Valuex1 As Boolean
For i = 1 To Range("C" & Rows.Count).End(xlUp).Row
Valuex = Evaluate("=IsNumber(Value(Mid(C" & i & ", 2, 1)))")
MsgBox (Valuex)
Valuex1 = Evaluate("=Left(Trim(C" & i & "), 1) = ""R""")
MsgBox (Valuex1)
If Valuex1 And Valuex Then
Range("D" & i).Formula = "=VLOOKUP(C" & i & ",[old.xls]Sheet1!$D:$V,19,0)"
MsgBox ("if")
Else
Range("D" & i).Formula = "=VLOOKUP(C" & i & ",[old.xls]Sheet1!$E:$V,18,0)"
MsgBox ("else")
End If
Next i
End Sub
I think you can avoid the loop altogether thus
Sub xx()
Dim i As Long
i = Range("C" & Rows.Count).End(xlUp).Row
With Range("D1:D" & i)
.Formula = "=IF(AND(ISNUMBER(VALUE(MID(C1, 2, 1))),LEFT(TRIM(C1), 1) = ""R""),VLOOKUP(C1,Sheet1!$D:$V,19,0),VLOOKUP(C1,Sheet1!$E:$V,18,0))"
.Value = .Value
End With
End Sub

VBA Code for Multiple if conditions

I need to categorize my data into different buckets. my worksheet has column V & Column Y (actually a name match & address match respectively) has values that are either "ok" or "check". Column O has IDs, of which some are only numeric and some are alpha numeric.i need to fill my column A based on these 3 columns.
category 1 - Column A to be filled with "Verify name & Address" - logic for this is - If Column A is blank, Column V value = "check", Column Y value = "check" and column O = all alphanumeric IDs (except that starts with CWT) and numeric IDs = 2 & 9612
Category 2 - Column A to be filled with "Verify Address" - logic for this is - If Column A is blank, Column V value = "ok", Column Y value = "check" and column O = all alphanumeric IDs (except that starts with CWT) and numeric IDs = 2 & 9612.
Sub Rules()
'
'Autofill based on Rules
Worksheets("ORD_CS").Activate
Dim sht As Worksheet
Dim LR As Long
Dim i As Long
Set sht = ActiveWorkbook.Worksheets("ORD_CS")
LR = sht.UsedRange.Rows.Count
With sht
For i = 8 To LR
If .Range("A" & i).Value = "" And Range("V" & i).Value = "check" And Range("Y" & i).Value = "check" And Range("O" & i).Value = "2" And Range("O" & i).Value = "9612" Then
.Range("D" & i).Value = "Verify Name & Address"
End If
Next i
End With
End Sub
I have not completed my code. Can someone help? Thanks
The below should work, I changed your O column to be an OR
Edit: for function
Public Function IsAlpha(strValue As String) As Boolean
Dim intPos As Integer
For intPos = 1 To Len(strValue)
Select Case Asc(Mid(strValue, intPos, 1))
Case 65 To 90, 97 To 122
IsAlpha = True
Case Else
IsAlpha = False
Exit For
End Select
Next
End Function
With sht
For i = 8 To LR
If .Range("A" & i).Value = "" And Range("V" & i).Value = "check" And Range("Y" & i).Value = "check" And Range("O" & i).Value = "2" Or Range("O" & i).Value = "9612" Or IsAlpha(Range("O" & i).Value) = True Then
.Range("D" & i).Value = "Verify Name & Address"
Else
If .Range("A" & i).Value = "" AND .Range("V" & i).Value = "ok" AND .Range("O" & i).Value = "2" Or .Range("O" & i).Value = "9612" Then
Do Stuff
End If
End If
Next i
End With

VBA nested looping with do until loop

I need a looping structure that checks a range of cells, then if the cell and a cell that is in the range equal each other then the font should turn red. My problem is that my do until loop won't get entered. This is what I have right now.
`
Dim finalrow As Long
finalrow = Worksheets("Redundancy").Cells(Worksheets("Redundancy").Rows.Count, "D").End(xlUp).Row
Dim z As Long
Dim w As Long
Dim r As Long
w = 2
r = 0
For z = 2 To finalrow
If Range("L" & z) = Range("L" & z + 1) & Range("J" & z) <> Range("J" & z + 1) Then
Do Until Range("L" & z) = Range("L" & z + 1) & Range("J" & z) <> Range("J" & z + 1)
If Cells(w, 4) = Cells(z + 1, 4 + r) Then
Cells(w, 1).Font.ColorIndex = 3
Cells(z + 1, 1).Font.ColorIndex = 3
If r = 4 Then
w = w + 1
End If
End If
r = r + 1
Loop
End If
Next z
`
I changed it to this, but it exits the loop all together right when it is about to enter the do while loop.
`
For z = 2 To finalrow
Do While (Range("L" & z) = Range("L" & z + 1) And Range("J" & z) <> Range("J" & z + 1))
If Cells(w, 4) = Cells(z + 1, 4 + r) Then
Cells(w, 1).Font.ColorIndex = 3
Cells(z + 1, 1).Font.ColorIndex = 3
If r = 4 Then
w = w + 1
End If
End If
r = r + 1
Loop
Next z
`
If you do this;
Range("L" & z) = Range("L" & z + 1) and Range("J" & z) <> Range("J" & z + 1)
you are comparing Range objects. What you instead want to do is to compare the values in those range objects. So use this instead;
Range("L" & z).value = Range("L" & z + 1).value and Range("J" & z).value <> Range("J" & z + 1).value
However when you use the cells(row,column) you don't have this problem.
I am curious though, was it not possible to use conditional formatting instead?
Use the 'and' operator instead of '&'.

Comparing list A and B with a function that choose the larger number and gives it a name

Im not very good at coding and trying to learn.
Right now I have two lists "Strategy A" and "Strategy B" that includes a long list of random numbers. I am trying to create a code where the function chooses a scenario and then compares the values within the strategies and labels it with "A" is that value is bigger and vice versa.
Currently I have this:
Dim i As Integer, j As Integer
For i = 9 To 1008
For j = 9 To 1008
If Sheet.Range("C" & i).Value > Sheet.Range("D" & j).Value Then
result = "A"
ElseIf Sheet.Range("D" & j).Value > Sheet.Range("C" & i).Value Then
result = "B"
ElseIf Sheet.Range("D" & j).Value = Sheet.Range("C" & i).Value Then
result = "AB"
End If
Next
I get invalid outside procedure when I use this code, and I get move on to the next part.. Which is creating a Sub with a FOR loop that reads the values and leaves the result in a result column.
I would to get some help on this!
Thanks!
Try this
Sub largestnum()
Dim i As Integer, j As Integer
Dim wk as worksheet
Set wk = sheet1 'change it to your sheet number
For i = 9 To 1008
For j = 9 To 1008
If wk.Range("C" & i).Value > wk.Range("D" & j).Value Then
result = "A"
ElseIf wk.Range("D" & j).Value > wk.Range("C" & i).Value Then
result = "B"
ElseIf wk.Range("D" & j).Value = wk.Range("C" & i).Value Then
result = "AB"
End If
Next j
Next i
End sub

VBA Text Array - Scan two columns for array string match rather than one

I have some code which is designed to scan Columns F & G for occurrences of words found in an array, the array containing text found in Column J. If it finds occurrences in either Column F or Column G, it will copy and paste the terms into the corresponding columns.
Column J contains free text from a field in SAP. The field is free text so it could be "Kerry John Pub Expenses" or "CATS O/H Kerry John", or even "CATS John Kerry O/H". There is no data entry standard for this field; this is what makes this task difficult .
Column F and Column G contains first names and last names. The code makes an assumption, if it finds an entry in column F or G that matches an entry in the txt array, it will copy and paste that entry.
During testing, the code proved not sufficient to match the outcomes which I was looking for, and the solution to this problem would be to match text in Columns F and G concurrently for two matching words rather than doing them in separate intervals.
I would like some suggestions as to how this code could be re-written to achieve this result.
Example of successful code run
Here we have 4 rows of data, John Citizen is located in Row 3, therefore the blank cells in Columns F and G, Row 2 can be populated with his first and last name.
The problem
Because I have two rows that contain Kerry Citizen and John Kerry, the row is populated with Kerry Kerry as a result, where the entry should be "John" in Column F and "Kerry" in Column G
Code starts here
Sub arraycolumnmatch()
Dim txtArray As Variant, T As Variant
Dim I As Long, J As Long
For I = 2 To Range("E50000").End(xlUp).row
typ = Range("F" & I).Value
If typ = "" Then
txt = Range("J" & I).Value
txtArray = Split(txt, " ")
For Each T In txtArray
For J = 2 To Range("F50000").End(xlUp).row
If Range("F" & J).Value = T Then
match_txt = T
Range("F" & I).Value = match_txt
End If
Next J
Next T
For Each T In txtArray
For J = 2 To Range("G50000").End(xlUp).row
If Range("G" & J).Value = T Then
match_txt = T
Range("G" & I).Value = match_txt
End If
Next J
Next T
End If
Next I
End Sub
You can simplify your code greatly, and make it work, like this:
typ = Range("F" & I).Value
If typ = "" Then
txt = Range("J" & I).Value
matchFound = False
For J = 2 To Range("G50000").End(xlUp).Row
If InStr(txt, Range("F" & J).Value) <> 0 _
And InStr(txt, Range("G" & J).Value) _
And Not (IsEmpty(Range("F" & J).Value)) _
And Not (IsEmpty(Range("G" & J).Value)) Then
'Both names match. Copy them.
Range("F" & I).Value = Range("F" & J).Value
Range("G" & I).Value = Range("G" & J).Value
matchFound = True
Exit For ' look no further.
End If
Next J
If Not matchFound Then MsgBox "No match found for: " & txt
End If
Tested, works for me.
The Code below runs for every first name on the list but only adds the name if both names match.
Sub arraycolumnmatch()
Dim txtArray As Variant, t As Variant
Dim I As Long, J As Long
For I = 2 To Range("G50000").End(xlUp).Row
typ = Range("F" & I).Value
If typ = "" And Not Range("J" & I).Value = Empty Then
txt = Range("J" & I).Value
txtArray = Split(txt, " ")
For Each word In txtArray
If Not word = "" Then
Set findtext = Range("F:F").Find _
(what:=(word), LookIn:=xlValues)
stoploop = False
loopcnt = 0
Do While Not findtext Is Nothing And stoploop = False And loopcnt < 21
loopcnt = loopcnt + 1
If InStr(txt, Range("F" & findtext.Row).Value) <> 0 _
And InStr(txt, Range("G" & findtext.Row).Value) Then
'Both names match. Copy them.
Range("F" & I).Value = Range("F" & findtext.Row).Value
Range("G" & I).Value = Range("G" & findtext.Row).Value
stoploop = True
Exit For ' look no further.
Else
Set findtext = Range("F" & findtext.Row & ":F" & 50000).Find _
(what:=(word), LookIn:=xlValues)
End If
Loop
End If
Next word
If Not stoploop Then MsgBox "No match found for: " & txt
End If
Next I
End Sub
Edit: Did an integration of #Jean InStr and a Find in Range which would allow for less loop time and a double match find.
I have had to stick with my original syntax, answer is below. Not the most efficient way of reaching the result, but it works
Sub arraycolumnmatch()
Dim txtArray As Variant, T As Variant
Dim I As Long, J As Long
For I = 2 To Range("E50000").End(xlUp).row
typ = Range("F" & I).Value
If typ = "" Then
txt = Range("J" & I).Value
txtArray = Split(txt, " ")
For Each T In txtArray
For J = 2 To Range("G50000").End(xlUp).row
If Range("G" & J).Value = T Then
match_txt = T
Range("G" & I).Value = match_txt
Exit For
End If
Next J
Next T
For Each T In txtArray
For J = 2 To Range("F50000").End(xlUp).row
If Range("F" & J).Value = T Then
match_txt = T
If Not Range("G" & I).Value = T Then
Range("F" & I).Value = match_txt
Exit For
End If
End If
Next J
Next T
End If
Next I