I know this will be a stupid simple answer, but it's killing me right now...
For Each cell In rng2
If cell.Offset(0, -13) And cell.Offset(0, -12).Value <> "" Then
cell.Value = 1
Else
cell.Value = 0
End If
Next cell
Where the .offset and .offset is, how can i just say
If cell.offset(0,12:13)
I know that's not it... This one is simple however, getting this piece right will save me so much headache throughout the vba code all over the workbook.
Thanks for helping this rookie in advance!
Maybe something like this:
For Each cell In rng2
If Application.CountA(cell.Offset(0, -13).Resize(1, 2)) = 2 Then
cell.Value = 1
Else
cell.Value = 0
End If
Next cell
Alternative using variant array
You can combine logical assumptions by multiplication (True * True corresponding to -1 * -1 = 1 in case of both reference cells greater"") and try the following:
'a) assign both offsets to variant 2-dim array
Dim v: v = rng2.Offset(0, -13).Resize(, 2)
'b) get values
Dim i As Long
For i = 1 To UBound(v) ' check each row
v(i, 1) = (v(i, 1) > 0) * (v(i, 2) > 0)
Next i
'c) write values
rng2.Resize(, 1) = v
Related
I have a macro with counter for unique values that met specific conditions. As you can see on the image, I have list of unique values in column F. Macro checks, if value is listed in column AE (can contain duplicated lines) and checks if there is no "OB" in column AH. Then returns how many values it found in cell K2. But I need this counter to also list these values in column AD, but I am struggling to make it happen. I checked many forums and managed to crash Excel twice already. Any ideas how to achieve it?
Dim myTbl As range, mStr As String, Miss As Long, xCol As Variant
Set myTbl = Sheets("OB").range("AE2") '
xCol = "AH"
mStr = ""
Set myTbl = range(myTbl, myTbl.End(xlDown).Offset(0, 1))
xCol = Cells(1, xCol).Column - myTbl.Cells(1, 1).Column + 1
For i = 1 To myTbl.Rows.count
If myTbl.Cells(i, 1) <> "" Then
If myTbl.Cells(i, xCol) <> "OB" And InStr(1, mStr, "##" & myTbl.Cells(i, 1), vbTextCompare) = 0 Then
mStr = mStr & "##" & myTbl.Cells(i, 1)
Miss = Miss + 1
End If
End If
Next i
If Miss > 0 Then
range("K2") = Miss & " still active"
range("K2").Font.ColorIndex = 46
Else
range("K2") = "None"
range("K2").Font.ColorIndex = 10
End If
Please, test the next code. It, also, is able to return how many occurrences per each Value x have been found (if more than one per each exist):
Sub ExtractUniqueCondValues()
Dim sh As Worksheet, lastR As Long, arr, i As Long, dict As Object
Set sh = Sheets("OB")
lastR = sh.Range("AE" & sh.rows.count).End(xlUp).row
arr = sh.Range("AE2:AH" & lastR).Value
Set dict = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(arr)
If arr(i, 4) <> "OB" Then dict(arr(i, 1)) = dict(arr(i, 1)) + 1
Next i
sh.Range("K2").Value = dict.count
sh.Range("AD2").Resize(dict.count, 1).Value = Application.Transpose(dict.Keys)
End Sub
About occurrences per each 'Value x' element, it can return in an adiacent column 'Value 2| 1 andValue 4` | 2, for your picture case... Of course, if it may have relevance for your purpose. The dictionary already keeps this data.
Maybe using formulas is an option for you? See column G where the formula in G2 is the following and copied down.
=IF(COUNTIFS(AE:AE,F2,AH:AH,"<>OB")>0,F2,"")
Using Count or Countifs may be an option instead of VBA.
I am attempting to create an Auto-grading test of sorts in Excel.
I have 5 values in Sheet1 that are input by a user in cells E5:E9. These should then be compared against a range of 5 more cells in Sheet2 (also cells E5:E9).
As the user might not always list these entries in the same order that I have in my Sheet2 range, I decided that I should loop through the range for each cell's input.
The next step would be to be able to ignore the value in the range once a match has been found but I need to get this part working correctly. Currently, the values absolutely match. However, I am not getting the correct output.
Sub Q1()
Dim i As Integer
For i = 5 To 9
If (Sheet1.Cells(5, 5) = Sheet2.Cells(i, 5)) And (Sheet1.Cells(6, 5) = Sheet2.Cells(i, 5)) And (Sheet1.Cells(7, 5) = Sheet2.Cells(i, 5)) And (Sheet1.Cells(8, 5) = Sheet2.Cells(i, 5)) And (Sheet1.Cells(9, 5) = Sheet2.Cells(i, 5)) Then
Sheet1.Cells(5, 6) = 1
Exit For
Else
Sheet1.Cells(5, 6) = 0
End If
Next
End Sub
I would expect the output of 1 to Sheet1 cell E6 but I am currently getting 0. Thanks!
Little Complex :)
Sub Q1()
Dim i As Integer
Dim j As Integer
Dim chck(5 To 9) As Boolean
For i = 5 To 9
For j = 5 To 9
If Sheet1.Cells(i, 5) = Sheet2.Cells(j, 5) Then
chck(i) = True
Exit For
Else: chck(i) = False
End If
Next
Next
j = 0
For i = LBound(chck) To UBound(chck)
If chck(i) = True Then j = j + 1
Next
If j = 5 Then
Sheet1.Cells(5, 6) = 1
Else: Sheet1.Cells(5, 6) = 0
End If
End Sub
Does this really need to be VBA? A formula can perform this calculation. Use this in 'Sheet1' cell F5:
=--(SUMPRODUCT(COUNTIF(Sheet2!E5:E9,E5:E9))>0)
If at least one of the values in 'Sheet1'!E5:E9 (the user entered values) exists in your 'Sheet2'!E5:E9 list, the formula will return a 1 else 0 which is the desired result based on your description.
As I could not find anyone posting something like this, I make this question.
I have some data that is "dirty" and I need to clean it.
In the picture in the link you can see a list of cars Column A is correct but the rest is wrong
I would need a code that could search Column A for information and then input the correct information into column F, G, H, I in similar way as shown in the picture
The dataset would be over 10000 lines
If the code could be customizeable also so that we could add more criterias that would be very helpfull
Thank you so much for replies.
Regards
Table in question
If I understand your problem correctly, you're trying to pull the "Petrol" or "Diesel" and put those in the second column, "LCV" or "Passenger Car" for the third column, and "Manual" and "Automatic" in the third column. If that is the case, then you could loop until the last value to go through everything, and then you could use the InStr value to see if the value is in the string, like they did here.
Sub CheckEntries()
Dim i As Integer
Dim iend As Integer
Dim rng As Range
Dim str As String
Set rng = 'Put the range you are trying to do test
iend = rng.Rows.Count
' This loops until it makes it to all values
For i = 1 To iend
str = rng.Cells(i, 1).Value
If InStr(0, str, "Petrol") > 0 Then
rng.Cells(i, 2).Value = "Petrol"
ElseIf InStr(0, str, "Diesel") > 0 Then
rng.Cells(i, 2).Value = "Diesel"
Else
rng.Cells(i, 2).Value = ""
End If
If InStr(0, str, "LCV") > 0 Then
rng.Cells(i, 2).Value = "LCV"
ElseIf InStr(0, str, "Passenger car") > 0 Then
rng.Cells(i, 2).Value = "Passenger car"
Else
rng.Cells(i, 2).Value = ""
End If
If InStr(0, str, "Manual") > 0 Then
rng.Cells(i, 2).Value = "Manual"
ElseIf InStr(0, str, "Automatic") > 0 Then
rng.Cells(i, 2).Value = "Automatic"
Else
rng.Cells(i, 2).Value = ""
End If
Next i
End Sub
This code will turn out a blank if the value doesn't include the value in the string. This should help with debugging if there is something wrong with the text in column 1.
So I am a student currently studying VBA. I'm doing ok in the class but still kind of iffy on what how to program. For the question I'm on I have to take numbers in a column and multiply them unless they are less than or equal to zero. Here is an example done by hand of what the result should look like (which are not the same numbers as the actual problem, these are much simpler).
Here is what I have written so far. I'm kinda treating the column as a 1 x 10 array.
Function multpos(C As Variant)
Dim i As Integer
Dim MD As Long
For i = 1 To 9
MD = C(1, i) * C(1, i + 1)
Next i
If C(i, 1) > 0 Then C(i, 1) = C(i, 1) Else C(i, 1) = 1
If C(i + 1, 1) > 0 Then C(i + 1, 1) = C(i + 1, 1) Else C(i + 1, 1) = 1
multpos = MD
End Function
While MD satisfies the equation, it only works for the first two and then doesn't. Intuitively I want to do something like this
MD = C(1, i) * C(1, i)
Next i
Etc but this is also not mathematically correct. So if I had
MD = C(1, i)
how can I get it to multiply by the next value from here? Feel free to look at my other code and correct me as well since that could just as easily be wrong. Thank you for help in advance.
Something like this should work for you. I tried to comment the code for clarity:
Public Function PRODUCTIF(ByVal vValues As Variant, ByVal sCriteria As String) As Double
Dim vVal As Variant
Dim dResult As Double
'Iterate through vValues and evaluate against the criteria for numeric values only
For Each vVal In vValues
If IsNumeric(vVal) Then
If Evaluate(vVal & sCriteria) = True Then
'Value is numeric and passed the criteria, multiply it with our other values
'Note that until a valid value is found, dResult will be 0, so simply set it equal to the first value to avoid a 0 result
If dResult = 0 Then dResult = vVal Else dResult = dResult * vVal
End If
End If
Next vVal
'Output result
PRODUCTIF = dResult
End Function
And you would call the function like this: =PRODUCTIF(A1:A10,">0")
you could exploit AutoFiler() method
Function multpos(C As Range, criteria As String)
Dim MD As Long
Dim cell As Range
With C.Columns(1)
If IsEmpty(.Cells(1, 1)) Then .Cells(1, 1) = "|header|"
.AutoFilter Field:=1, Criteria1:=criteria
If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then
MD = 1
For Each cell In C.SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants, xlNumbers)
MD = MD * cell.Value
Next cell
End If
If .Cells(1, 1) = "|header|" Then .Cells(1, 1).ClearContents
.Parent.AutoFilterMode = False
End With
multpos = MD
End Function
to be exploited in your main sub like:
MsgBox multpos(Range("A1:A10"), ">0")
The program I am working on involves reading and determining the difference between i - (i+1) and i-(i-1) from excel.
If the difference exceeds 4 then the program deletes the row at i.
The program works well at the first try. Suddenly, it says that "You can not change part of an Array".
Option Explicit
Sub Data_Delet()
Dim a As Double, b As Double, c As Double, i As Double
Dim rkill As Range
' a,b, and c are used as steps in order to proceed to the next data points
a = 18
b = 0
c = 0
With ThisWorkbook.Worksheets("Sheet1")
' The second do loop delete data points that does not follow the requirements
Do
If Abs(.Cells(a - 1, 2) - .Cells(a, 2)) > 4 And Abs(.Cells(a, 2) - .Cells(a + 1, 2)) > 4 Then
If rkill Is Nothing Then
Set rkill = Rows(a)
Else
Set rkill = Union(rkill, Rows(a))
End If
End If
a = a + 1
Loop Until .Cells(a, 2).Value = ""
If Not rkill Is Nothing Then rkill.EntireRow.Delete
' The third Do loop determines the number of data points that are still present after deleting the data points
Do
i = .Cells(17 + c, 1)
c = c + 1
Loop Until .Cells(17 + c, 1).Value = ""
' The if statment determine whether or not the number data points from before are the same after deletion process
If b = c Then
.Cells(2, 5) = "N"
Else
.Cells(2, 5) = "Y"
End If
' c is the number of data point after deletion
.Cells(12, 5) = c
End With
End Sub
The error "You cannot change part of an array" on rkill.EntireRow.Delete means that the row you want to delete is intersecting a range referenced in an array formula (a formula with braces).
Excel does not allow this. One way would be to remove the offending array formula(s) at the start of your code, and redefine it/them again at the end of your code. Or find a solution to turn these array formulas into normal formulas.