excel macros checking for value and moving to cell below - excel

so Ive got programming knowledge but i need help with excel
i need to create a macro that checks for a specific value in a cell (e.g. begins with "01A") and if it finds it to check the cell underneath it for the same value. It should keep doing that until the value changes. I would also like it to calculate how many times it found that specific value (counta())
here is an example i would use if i were to do something similar in c
if (value = 01a){
amount ++
value + 1
}
any help is greatly appreciated

If you need to search only the first occurrance in a range, use:
Public Function FoundRec(Str As String, x As Range) As Integer
Application.Volatile
Dim i As Integer
Set c = x.Find(Str, after:=x.Item(x.Rows.Count), LookIn:=xlValues)
If c Is Nothing Then
FoundRec = 0
Exit Function
End If
For i = 1 To 9999
If c.Offset(i, 0).Value <> c.Value Then Exit For
Next
FoundRec = i
End Function
This function search the string Str in the range x :
=FoundRec("01A";A2:A16)
Return 0 if don't found.
If you need to search in the other occurrance, you can use:
Public Function FoundRecR(Str As String, x As Range, StartR As Integer) As Single
Application.Volatile
Dim i, e As Integer
Dim xx As Range
Set xx = x.Item(1)
For e = 1 To StartR
If e = 1 Then
Set c = x.Find(Str, after:=x.Item(x.Rows.Count), LookIn:=xlValues)
Else
Set c = x.Find(Str, after:=xx, LookIn:=xlValues)
End If
If xx.Row > c.Row Then ' Restart to Find ...
FoundRecR = -1
Exit Function
End If
If c Is Nothing Then
FoundRecR = 0
Exit Function
End If
For i = 1 To 9999
If c.Offset(i, 0).Value <> c.Value Then Exit For
Next
Set xx = c.Offset(i - 1, 0)
Next
FoundRecR = i
End Function
The function search the occurrance StartR of the string Str in the range x:
=FoundRecR("01A";A2:A16;1)
Return 0 if don't found and -1 if the occurrance it's to high (no other occurrance).
The After parameter it's necessary to force Excel to start from the first cell of the range, otherwise Excel ignore...

Related

Disregarding Value of Zero on a Cell when Comparing for > 0

would like to ask if there is a way to disregard 0 value when comparing?
to be specific i need to compare a value greater than zero if they are equal..and if so, a msgbox "" will appear ... to be honest i am not knowledgeable so i just used if statement... and need to compare 7 cells... i have to redundantly use if then statement for ever possible 0 and non zero combinations. (which ofc. alot)
example all zeroes will be neglected, if for instance cellA = 2 and CellB = 0 and CellC = 2 then it will show a msgbox because cellA an cellC is > 0 and have the same value(which is correct). but when i turned cellA = 0 and CellB = 0 and Cell3 = 0 ...it still showing a msgbox.. i was hoping that when all the cells turned 0 it will neglect the condition "if A = B, B = C then appear msgbox" but will consider the condition if it is > 0.
Advance thanks
This will do it:
Option Explicit
Sub msgBx()
'Set some vars
Dim sourceArr, dict As Object, j As Long, i As Long
'get data in memory = array
sourceArr = Sheet1.Range("A1:A7").Value2
'build a dict to compare quickly
Set dict = CreateObject("Scripting.Dictionary") 'create dictionary lateB
For j = 1 To UBound(sourceArr, 2) 'traverse source
dict(sourceArr(1, j)) = Empty
Next j
'check if key exists in dict and copy data
For j = 1 To UBound(sourceArr)
For i = 1 To UBound(sourceArr, 2)
If sourceArr(j, i) <> 0 And dict.Exists(sourceArr(j, i)) Then
MsgBox "gotya"
End If
Next i
Next j
End Sub

How to search for a specific data of consecutive numbers in a column of an excel even if multiple instances are present

How can I find multiple instances of presence of consecutive numbers in a column of big data of 1's and 0's in excel spreadsheet.
For example, my excel column is given below:
0
0
1
1
0
0
1
0
1
0
0
1
1
0
1
1
1
0
0
1
1
0
0
1
0
Please assume this as some of my column data, I need to find wherever the sequences of 1's and 0's present in the column.
I defined a function for finding single instance as below:
Function FINDSEQ(seq As String, rng as Range) As Long
FINDSEQ = InStr(1, Join(Application.Transpose(rng.Value), ""), seq)
End Function
But I couldn't find how to find multiple instances if present.
For Example, I need to find:
1
1
0
0
1
0
as the sequence of consecutive numbers, what change should I do?
Here 1 1 0 0 1 0 is present two times, but based on the above defined function I could only find a single instance.
Add a sp (starting position) parameter to the FINDSEQ function:
Function FINDSEQ(seq As String, rng As Range, sp As Integer) As Long
FINDSEQ = InStr(sp, Join(Application.Transpose(rng.Value), ""), seq)
End Function
and then continue the search from the immediate next position from any found matching string:
newpos=FINDSEQ(1)
Do While newpos>0
Debug.Print newpos
newpos=FINDSEQ(newpos+1)
Loop
Try the next function, please:
Function FINDSEQ(seq As String, rng As Range) As Long
FINDSEQ = UBound(Split(Join(Application.Transpose(rng.Value), ""), seq))
End Function
And call it in the next way:
Sub testFINDSEQ()
Dim sh As Worksheet, rng As Range
Set sh = ActiveSheet
Set rng = sh.Range("A1:A25")
Debug.Print FINDSEQ("110010", rng)
End Sub
Or from a cell (like UDF):
=FINDSEQ("110010",A1:A25)
Do not forget to delete your already existing function
Was hoping you would give it a bit more of a try yourself first after your previous question. I'd also go with the first parameter of InStr, but a little different to #JMP:
Function FINDSEQ(rng As Range, seq As String) As String
Dim x As Long, y As Long: x = 1
Do While InStr(x, Join(Application.Transpose(rng.Value), ""), seq) > 0
y = InStr(x, Join(Application.Transpose(rng.Value), ""), seq)
If FINDSEQ = "" Then
FINDSEQ = y
Else
FINDSEQ = FINDSEQ & "," & y
End If
x = y + 1
Loop
End Function
The function has now also changed from Long type to String.

how to not enter if statement inside a loop if it have been executed

I have a for loop, and inside it i have if statement.
In my Excel I have a list that contains each value one time. Once I found it i don't want the code to even check the conditional, i want it to skip this part of the if statement completely each time the loop is executed, is it possible?
Here is my code and list:
the first iteration of the loop will find that "c" is the value so it will do what inside it (xc = i)
I don't want the code to even check "ElseIf Cells(1, i) = "c" again, like the following image, is this possible?
code as text:
Sub test()
Dim i, xa, xb, xc As Integer
For i = 1 To 5
If Cells(i, 1) = "a" Then
xa = i
ElseIf Cells(i, 1) = "b" Then
xb = i
ElseIf Cells(i, 1) = "c" Then
xc = i
End If
Next i
End Sub
My initial interpretation of your need was "if the code hits 'c' again, just don't act".
To do so, you could modify the logic as follows:
ElseIf (xc = 0) And (Cells(i, 1) = "c") Then
This way, as soon as xc is set, the first boolean expression would be False, and the overall condition would not ever be met again. As mentioned by #TimWilliams, VBA would still evaluate the second boolean expression, unlike other languages that feature short-circuiting options. #Gene's answer describes a way around this. Typically, for better performance, you would evaluate the simple conditions first, before resorting to costly ones.
Additional notes
In VBA, you must give a type to each variable. In your Dim line, only xc is an Integer, while the other variables are Variants.
An unqualified Cells() call operates on the currently active worksheet, which might not be the expected one. Suggestion: qualify Cells() with the CodeName of your worksheet. The CodeName is what you see or specify under a worksheet's (Name) property as seen from the Visual Basic editor. For example, if (Name) is Sheet1, use Sheet1.Cells(). This will only work if the code resides in the same workbook as Sheet1. If the code is behind the worksheet itself, you can even use Me.Cells().
When dealing with cell values as your code does, VBA is (silently) being nice and understands that, among the numerous properties of the Range class, Value is what you are interested in. It is better practice, however, to explicitly state the target property, such as in Sheet1.Cells(i, j).Value.
EDIT
Knowing the values will be distinct and that there are about 60 of them, I suggest you simply use a Dictionary, as shown below, to get each value's row in one go, without a cascade of Ifs:
Option Explicit
Sub test()
Dim i As Integer
Dim dict As Object 'Scripting.Dictionary
Set dict = CreateObject("Scripting.Dictionary")
For i = 1 To 5
dict(Cells(i, 1).Value) = i
Next
Debug.Print dict("a") '4
Debug.Print dict("b") '2
Debug.Print dict("c") '1
'Etc.
End Sub
if i understood your question you can try this code:
Sub test()
Dim i, xa, xb, xc As Integer
Dim a, b, c As Boolean
a = False
b = False
c = False
For i = 1 To 5
If Cells(i, 1) = "a" And a <> True Then
xa = i
a = True
ElseIf Cells(i, 1) = "b" And b <> True Then
xb = i
b = True
ElseIf Cells(i, 1) = "c" And c <> True Then
xc = 1
c = True
End If
Next i
End Sub
Boolean variable is setted true for example only when the cells(i,1)="a" and after the next "a" value are skipped...
hope this helps
I just wanted to "mod" Ferdinando's code so it's a bit more "readable", I think. The main (the substantive) difference between this version and Ferdinando's or Excelosaurus' is that the cell is not even tested once the value is detected. Remember that the question was: I don't want the code to even check "ElseIf Cells(1, i) = "c" again... So, this version does exactly that.
Sub test()
Dim i As Integer, xa As Integer, xb As Integer, xc As Integer
Dim aFound As Boolean, bFound As Boolean, cFound As Boolean
Dim r As Range
For i = 1 To 5
Set r = Cells(i, 1)
If Not aFound Then
If r = "a" Then xa = i: aFound = True
ElseIf Not bFound Then
If r = "b" Then xb = i: bFound = True
ElseIf Not cFound Then
If r = "c" Then xc = i: cFound = True
End If
Next i
End Sub
I don't like the idea of 60 ElseIfs. Please examine the code below. In order to test it, create a worksheet called "TestSheet" and enter your A1:A5 to cells H2:H6.
Sub TestSpike()
' 06 Jan 2019
Dim Rng As Range
Dim Items As Variant
Dim Spike As String
Dim Tmp As String
Dim i As Integer
Dim R As Long
Items = Split("c|b|0|a|1", "|")
With Worksheets("TestSheet").Columns("H")
For R = 2 To 6
Tmp = CStr(.Cells(R).Value)
If InStr(1, Spike, Tmp, vbTextCompare) = 0 Then
Spike = Spike & "|" & Tmp
On Error Resume Next
i = Application.WorksheetFunction.Match(Tmp, Items, 0)
If Err Then
MsgBox Tmp & " wasn't found in Array"
Else
MsgBox "i = " & i & " = Item " & Tmp
End If
End If
Next R
End With
End Sub
The code has a "Spike". Each item is first checked against the Spike. If it is found there no further tests are carried out. Else, it is added to the Spike.
New items, after being added to the Spike, are checked against the Array "Items" which would hold your 60 elements, separated by Chr(124) thus, Split("c|b|0|a|1", "|"). I use the worksheet function MATCH to look for the item in the array. The result is an index number (or an error, if not found). You can use this index number in a Select Case statement to process each item distinct from others, basically the same way as you now process it when the If statement returns True.
One idea you may find useful with this kind of setup is to use the index from the Match function to return a value from another array. The other array might, for example, contain function names and you use Application.Run to call a different function for each item. This would run significantly faster than examining 60-odd Select Case statements.

COUNTIF/SUMIF gives error if criteria string is longer than 256 characters

While trying to use COUNTIF and SUMIF with a table that regularly has long comments, I kept getting a #VALUE error. A little bit of research said that the error could be due to the criteria string topping the 256 character point.
Any suggestions on how to get around this? I've worked out a solution I'll be posting as an Answer, but I'd like to see if anyone else has a Better Way.
I ended up writing a pair of UDFs in VB to get around the issue. There's still a character limit, but now it's 2^32, rather than 2^8.
The COUNTIF variation was pretty straightforward...
Function COUNTIFLONG(rng As Range, crt As String, ExactMatch As Boolean)
Dim Cell As Range
Dim x As Integer
x = 0
For Each Cell In rng
If IsNull(Cell.Value) Then GoTo CellCont
If ExactMatch Then
If Cell.Value = crt Then
x = x + 1
End If
Else
If (InStr(Cell.Value, crt) > 0) Then
x = x + 1
End If
End If
CellCont:
Next Cell
COUNTIFLONG = x
End Function
The SUMIF variation was a bit more tricky to get it to be flexible enough for regular use.
Function SUMIFLONG(rngCrt As Range, crt As String, rngSum As Range, ExactMatch As Boolean)
Dim Cell As Range
Dim x As Integer
Dim CrtRows As Integer, CrtCols As Integer, SumRows As Integer, SumCols As Integer
Dim RowOffset As Integer, ColOffset As Integer
Dim SumDir As String
CrtRows = rngCrt.Rows.Count
CrtCols = rngCrt.Columns.Count
SumRows = rngSum.Rows.Count
SumCols = rngSum.Columns.Count
crt = Trim(crt)
x = 0
If (CrtRows <> SumRows) Or (CrtCols <> SumCols) Then
Debug.Print ("Arrays are not the same size. Please review the formula.")
Exit Function
End If
If (CrtRows <> 1) And (CrtCols <> 1) And (SumRows <> 1) And (SumCols <> 1) Then
Debug.Print ("Please restrict arrays to one column or row at a time.")
Exit Function
End If
'Detects the offset of the Sum row/column from the Criteria row/column
RowOffset = rngSum.Row - rngCrt.Row
ColOffset = rngSum.Column - rngCrt.Column
For Each Cell In rngCrt
'Ignores Null cells or rows where the Sum column's value is not a number.
If IsNull(Cell.Value) Or (Not IsNumeric(Cell.Offset(RowOffset, ColOffset).Value)) Then
GoTo CellCont
End If
'Adds Sum Column's value to the running total.
'If an Exact Match is not requested, will detect whether Criteria is present in target cell.
If ExactMatch Then
If Cell.Value = crt Then
x = x + Cell.Offset(RowOffset, ColOffset).Value
End If
Else
If (InStr(Cell.Value, crt) > 0) Then
x = x + Cell.Offset(RowOffset, ColOffset).Value
End If
End If
CellCont:
Next Cell
SUMIFLONG = x
End Function
As I said, I'd like to see if anyone had better Ideas of how to accomplish this, but I hope this helps!
Without sample data any suggestion is going to involve some guesswork but it sounds like your search criteria could be chopped down to unique pieces less than the 255 character limit and wrapped in wildcards.
=COUNTIF(A:A, "*"&C2&"*")
        Click for full size image

Pass Excel Range in VBA Function, Process as Array, and Return Result

I have an Excel worksheet with some strings in a column. Sometimes all of the entries are the same, and sometimes not:
I wrote a function to pass the range as a parameter:
=Dent_WG(A1:A6)
The VBA function should determine which case is true (all entries = "Al", or at least one entry = "Ag"), then return 0 or 12 respectively:
Function DentWG(WG_Mat As Range) As Single
Dim dat As Variant, rw As Variant, temp As Single
dat = WG_Mat
temp = 0
For rw = LBound(dat, 1) To UBound(dat, 1)
If dat(rw, 1) = "Ag" Then
temp = 12
End If
Next
If temp = 12 Then
DentWG = 12
Else
DentWG = 0
End If
End Function
However, the function always returns 0, even for the 2nd case where "Ag" occurs in the range. I'm sure I'm failing to correctly convert the range into an array or correctly apply the intended logic to that array.
From your question...
The VBA function should determine which case is true (all entries = "Al", or at least one entry = "Ag"), then return 0 or 12 respectively:
This is what you need.
Function DentWG(WG_Mat As Range) As Long
Dim ClCount As Long
ClCount = WG_Mat.Cells.Count
If Application.WorksheetFunction.CountIf(WG_Mat, "Al") = ClCount Then
DentWG = 0
ElseIf Application.WorksheetFunction.CountIf(WG_Mat, "Ag") > 0 Then
DentWG = 12
End If
End Function
The same can be achieved using a formula
=IF(COUNTIF(A1:A6,"Al")=(ROWS(A1:A6)*COLUMNS(A1:A6)),0,IF(COUNTIF(A1:A6,"Ag") > 0‌​,12,""))
In case it will always be 1 Column then you don't need *COLUMNS(A1:A6). This will do.
=IF(COUNTIF(A1:A6,"Al")=ROWS(A1:A6),0,IF(COUNTIF(A1:A6,"Ag") > 0,12,""))
ScreenShot
You don't really need a UDF for this. You could just say:
=IF(COUNTIF(A1:A6,"Ag")>=1,12,0)
This works for me:
Function DentWG(WG_Mat As Range) As Single
Dim result As Single, cl as Range
result = 0
For Each cl In WG_Mat
If cl = "Ag" Then
DentWG = 12
Exit Function
End If
Next cl
DentWG = result
End Function

Resources