finding the lowest value in a cell Excel VBA - vba

I am new to this. I am trying to find the lowest value in a cell with multiple values inside. For example,
48
44.50
41.00
37.50
I am trying to find 37.50. What should be the code for it?
Thanks

Based on your posted example:
Sub FindMin()
Dim s As String, CH As String
Dim wf As WorksheetFunction
Dim bry() As Double
Set wf = Application.WorksheetFunction
s = ActiveCell.Text
CH = Chr(10)
ary = Split(s, CH)
ReDim bry(LBound(ary) To UBound(ary))
For i = LBound(ary) To UBound(ary)
bry(i) = CDbl(ary(i))
Next i
MsgBox wf.Min(bry)
End Sub
This assumes that there is a hard return (ASCII-10) between the fields in the cell.
EDIT#1:
To make it into a function, remove the sub and replace with:
Public Function FindMin(r As Range) As Variant
Dim s As String, CH As String
Dim wf As WorksheetFunction
Dim bry() As Double
Set wf = Application.WorksheetFunction
s = r.Text
CH = Chr(10)
ary = Split(s, CH)
ReDim bry(LBound(ary) To UBound(ary))
For i = LBound(ary) To UBound(ary)
bry(i) = CDbl(ary(i))
Next i
FindMin = wf.Min(bry)
End Function
EDIT#2:
based on your comment, here is an example of input vs output:
Note that all the values are in a single cell and the values are separated by hard returns rather than spaces.

By code with same cell and a " " as delimiter to break
temp = Range("A1").Value
temp = Split(temp, " ")
Low = CInt(temp(0))
For i = 0 To UBound(temp) - 1
If CInt(temp(i)) < Low Then Low = CInt(temp(i))
Next
Range("a2").Value = Low
if they are in a range you can use a formula
=MIN(A1:A4)

This question is pretty close to one previously asked:
VBA/EXCEL: extract numbers from one cell that contained multiple values with comma
If you take the code from that answer and replace the comma with whatever is separating your values, you will be able to get access to them in VBA. Then you can write code to find the minimum.

You can make a macro to split the values for each cell you selected and then check for the highest value. And a quick check to make sure you are not parsing all the empty rows (when you selected a column).
The macro below will set the highest value in the next column.
Sub lowest()
Dim Values As Variant
Dim LowestValue As Double
Dim a As Range
Set a = Selection
For Each Row In a.Rows
For Each Cell In Row.Cells
LowestValue = -1
Values = Split(Cell.Value, Chr(10))
For Each Value In Values
If LowestValue = -1 Then
LowestValue = Value
ElseIf Value < LowestValue Then
LowestValue = Value
End If
Next
Cells(Cell.Row, Cell.Column + 1).Value = LowestValue
If IsEmpty(Cell.Value) Then GoTo EndLoop
Next Cell
Next Row
EndLoop:
End Sub

Related

vba combine a few lines in one cell

I have a three columns in excel with data such as
section1 section2 section3
no no er3
er1 no er3
no no no
how to write macros to Combine the data in the on column such as:
section_error
er3
er1,er3
no
So if there are only "no" then it should be once "no"
if there is something else besides "no", like "er1"or "er3" then only list of others signs.
it is not exactly to join or to CONCATENATE (
So, this might be a bit overkill depending on how many rows you have. But, using arrays is going to be a lot faster if you start getting up in the thousands.
Anyway, we define two named ranges, input and output. We then place the values of the input range into an array.
We loop through the array, checking the values of those spots in the array (which corresponds to the values in the cells now). When we find something, we append that something to the end of our output value for that row. When we don't find anything, we set that value to no.
At the end, we set the values of the output range (resized for our array) equal to our output array values.
Make sure you define those named ranges (and change their names too!).
Let me know if you have questions.
Option Explicit
Sub combineColumns()
Dim combineRange As Range, pasteRange As Range
Dim inputArr() As Variant, outputArr() As Variant, i As Long, j As Long, numberOfRows As Long
Dim currentOutputvalue As String
'Named range with values to combine, don't include header
Set combineRange = Range("yourNamedRangeToCombineHere")
'only need to set the top of the range to paste
Set pasteRange = Range("theCellAtTheTopOfWhereYouWantToPaste")
'put the values of the range you want to combine into the input array
inputArr = combineRange.Value2
'find the size of the array
numberOfRows = UBound(inputArr, 1)
'dimension the output array, same number of rows, but only one column
ReDim outputArr(1 To numberOfRows, 1 To 1)
'loop through our rows
For i = 1 To numberOfRows
'set the current output value to a blank
currentOutputvalue = ""
'loop through our three columns
For j = 1 To 3
'if cell value is not no, append the value to the end of current output value
'also append a comma
If inputArr(i, j) <> "no" Then
currentOutputvalue = currentOutputvalue & inputArr(i, j) & ","
End If
Next
If currentOutputvalue = "" Then
'all columns in this row were "no", so change value to "no"
currentOutputvalue = "no"
Else
'there was at least one not no
'trim off the end comma
currentOutputvalue = Left(currentOutputvalue, Len(currentOutputvalue) - 1)
End If
'assign the value to the spot in the array
outputArr(i, 1) = currentOutputvalue
Next
'resize the pasterange to the size of the array, and
'set the values of the range to those in the output array
pasteRange.Resize(numberOfRows, 1).Value2 = outputArr
End Sub
Here's a macro solution, just looping through the rows/columns:
Sub Test()
Dim i As Long, j As Long, lastrow As Long
Dim mystring As String
lastrow = Worksheets("ICS Analysis").Cells(Worksheets("ICS Analysis").Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrow
For j = 1 To 3
If InStr(Worksheets("ICS Analysis").Cells(i, j).Value, "er") > 0 Then
If mystring = "" Then
mystring = Worksheets("ICS Analysis").Cells(i, j).Value
Else
mystring = mystring & "," & Worksheets("ICS Analysis").Cells(i, j).Value
End If
End If
Next j
If mystring <> "" Then
Worksheets("ICS Analysis").Cells(i, 4).Value = mystring
mystring = ""
Else
Worksheets("ICS Analysis").Cells(i, 4).Value = "no"
End If
Next i
End Sub

Extract an alphanumeric from sentence

I would like to have an VBA to extract an alphanumeric value from a column G which is a sentence.
This sentence is generally a comment. So it includes characters and numbers.
The value always starts with AI0 and ends with 0. This can be 11 to 13 digits long. Sometimes the number is mentioned in the comment as AI038537500, also sometimes as AI038593790000.
I have researched through almost all the websites, but have not found any case like this. I know about the formulas, left, right, mid but in my case, it doesn't apply.
Any lead would be appreciable.
You may try something like this...
Place the following User Defined Function on a Standard Module and then use it on the sheet like
=GetAlphaNumericCode(A1)
UDF:
Function GetAlphaNumericCode(rng As Range)
Dim Num As Long
Dim RE As Object, Matches As Object
Set RE = CreateObject("VBScript.RegExp")
With RE
.Global = False
.Pattern = "AI\d{9,}0"
End With
If RE.Test(rng.Value) Then
Set Matches = RE.Execute(rng.Value)
GetAlphaNumericCode = Matches(0)
Else
GetAlphaNumericCode = "-"
End If
End Function
Why not give something like the following a try?
Sub findMatches()
Dim strLength As Integer
Dim i As Long
For i = 1 To Rows.Count
Dim AllWords As Variant
AllWords = Split(Cells(i, 7).Value, " ")
For Each Item In AllWords
strLength = Len(Item)
If strLength > 0 And strLength <= 13 And Item Like "A10*?#" Then
Cells(i, 8) = Item
End If
Next
Next i
End Sub
Test Cases:
I am apple and my batch number is: A10545440 so incase you needed to know
Result: A10545440
Some random comment… A20548650
Result: NO RESULT
A101234567891 is an awesome alphanumeric combo
Result: A101234567891
Another random comment… A10555
Result: A10555
Notice: The above example covers cases where the alphanumeric combo, starting with A10 is either:
In the middle of a sentence, or
Beginning of a sentence, or
At the end of a sentence
Also note: right now it is set to go through ALL the rows... so if you want to limit that, change the Rows.Count in the For statement to whatever your set limit is.
EDIT:
In the above code, I am explicitly asking it to look in column G
can you give this a try? I think it should do the job, also you should ammend the code with the column values, I tested it with the comments being in column C, while the code will be written in column D.
Option Explicit
Sub FindValue()
Dim i As Long
Dim lastrow As Long
Dim lFirstChr As Long
Dim lLastChr As Long
Dim CodeName As String
lastrow = activesheet.Range("c" & Rows.Count).End(xlUp).Row
' gets the last row with data in it
For i = 1 To lastrow
' shuffles through all cell in data
lFirstChr = InStr(1, Cells(i, 3), "A10") ' gets the coordinate of the first instance of "A10"
If lFirstChr = 0 Then GoTo NextIteration
lLastChr = InStr(lFirstChr, Cells(i, 3), " ") ' gets the coordinate of the first instansce of space after "A10"
If lLastChr = 0 Then 'if there is no space after A10 then sets lastchr to the lenght of the string
lLastChr = Len(Cells(i, 3))
End If
CodeName = Mid(Cells(i, 3).Value, lFirstChr, lLastChr - lFirstChr) ' extracts the codename from the string value
Range("d" & i).Value = CodeName
Goto NextTteration
NextIteration:
Next i
End Sub

How can I remove non-numeric characters in cells and concatenate result to URL?

I have a bunch of cells with string like this:
WFM 1601
And this:
WFM 2231, WFM 2402
And this too:
Campaign 1680, 2402, 2784
I used code, below, to split the string in a single cell into multiple columns (max of 3).
Dim Rng As Range
Dim WorkRng As Range
On Error Resume Next
lRow = Range("U" & Rows.Count).End(xlUp).Row
Set MyRows = Range("U19:U" & lRow)
For Each cell In MyRows
splitVals = Split(cell.Value, ",")
totalVals = UBound(splitVals)
Range(Cells(cell.Row, ActiveCell.Column + 1), Cells(cell.Row, ActiveCell.Column + 1 + totalVals)).Value = splitVals
Next
Now, I'm trying to figure out a way to get rid of all NON numeric characters and leave only numbers. Then, concatenate these numbers, which are all IDs for processes in a SharePoint site that I work with, so I want to place the URL for each number, at the end of a static string, and next to the number that was just split into separate columns.
Here is a screen shot.
I have Column U, and I want to generate Column V to Column AA.
I can extract only numbers using the function below.
Function GetNums(target As Range)
Dim MyStr As String, i As Integer
MyStr = ""
If Len(target.Value) = 0 Then GoTo GoExit
If target.Value = "None" Then GoTo GoNone
For i = 1 To Len(target.Value)
If IsNumeric(Mid(target, i, 1)) Then MyStr = MyStr & Mid(target, i, 1)
Next i
GoTo GoExit
GoNone:
GetNums = "None"
Exit Function
GoExit:
GetNums = MyStr
End Function
However, this won't meet the requirement as it checks all characters in a cell, and just turns this: WFM 2231, WFM 2402 . . .
Into this: 22312402
I really need some way to distinguish the two IDs: 2231 2402
I would use Regular Expressions to extract the number groups. If it turns out there are other criteria for what constitutes a valid digit sequence, that would be easier to implement by changing the regex.
Here's an example with your original Data in Column A of the active sheet.
Option Explicit
Sub CreateURL()
Dim RE As Object, MC As Object, M As Object
Const sPat As String = "\b\d+\b" 'whole words that are all digits
Const sBaseURL As String = "htpps://collaborate.process...&ID="
Dim I As Long, J As Long
Dim rSrc As Range, C As Range
'This will be on active sheet
'Suggest you specify actual worksheet
Set rSrc = Range(Cells(1, 1), Cells(Rows.Count, "A").End(xlUp))
Set RE = CreateObject("vbscript.regexp")
With RE
.Pattern = sPat
.Global = True
End With
For Each C In rSrc
If RE.test(C.Text) = True Then
Set MC = RE.Execute(C.Text)
J = -1
For Each M In MC
J = J + 2
C.Offset(0, J) = M
C.Offset(0, J + 1) = sBaseURL & M
Next M
End If
Next C
End Sub
And here's the results of running this macro against data in column A:
Here is a formal explanation of the Regex, with links to more detail that hopefully still work:
\b\d+\b
\b\d+\b
Options: Case insensitive; ^$ match at line breaks
Assert position at a word boundary (position preceded or followed—but not both—by an ASCII letter, digit, or underscore) \b
Match a single character that is a “digit” (ASCII 0–9 only) \d+
Between one and unlimited times, as many times as possible, giving back as needed (greedy) +
Assert position at a word boundary (position preceded or followed—but not both—by an ASCII letter, digit, or underscore) \b
Created with RegexBuddy
I can help for the 1st part, to check if a value is numeric or not.
You did the split. Now, you can check if the variables you get are numeric or not. Example :
We want to check if the value in A1 is numeric :
isnum = isNumeric(range("A1"))
isnum is true if the value in A1 is numeric, else it is false.

Excel count target then output value in cell

I have a workbook with three sheets (Dash, HT, RV.)
I am trying to write a macro/function that counts how many times a value from 'Dash' exists in a specific column within sheet 'RV' then output that value in a specific cell within 'Dash'
I could go so far as to say that the value within 'Dash' is static and repeat it (The variable from 'Dash' won't ever change as it's a list of Usernames)
In my head it's something like: Count whatever.variable.Dash in column J of sheet.RV print in Dash.B2...
I was able to find a MsgBox option that works, but I have to manually type in each Username (which is a 16character name (string)) then a MsgBox tells me the occurrences. I'm looking to just automate this option with a fixed/static username in the macro/function because the amount of rows in 'RV' can vary between 700 entries to 23k entries
The MsgBox option is:
Dim Count as Integer
Dim Target As String
Dim Cell as Object
Dim N As Integer
Sub Target_Count()
Count = 0
Target = InputBox("character(s) to find?")
If Target = "" Then GoTo Done
For Each Cell in Selection
N = InStr(1, cell.Value, target)
While N <> 0
Count = count + 1
N = InStr(n + 1, cell.Value, target)
Wend
Next Cell
MsgBox count & " Occurrences of " & target
Done:
End Sub
I want the input box target to be 'Dash.A1:8' and the occurrences to be printed in 'Dash.B1:8'
Can you just use a countif() formula rather than programming a macro? say the column you were counting the "dash"'s in was column B in sheet RV, Then in the cell in sheet Dash, the formula would be:
=COUNTIF(RV!B:B,"dash")
Or, if you wanted to vary what you were counting, you simply replace the hardcoded "dash" in the formula with the input cell address.
If you want VBA you can use this. Adjust it however you want.
Sub Target_Count_2()
Dim wb As Workbook
Set wb = ThisWorkbook
Dim Cell As Range
Dim Count As Integer
Dim LastRow As Long
LastRow = wb.Worksheets("RV").Range("A1").SpecialCells(xlCellTypeLastCell).Row
Dim strArr() As Variant
strArr() = wb.Worksheets("RV").Range("J1:J" & LastRow).Value
Dim i As Long
Dim str As String
For Each Cell In wb.Worksheets("Dash").Range("B1:B8")
Count = 0
str = Cell.Offset(, -1).Value2
For i = LBound(strArr) To UBound(strArr)
If str = strArr(i, 1) Then Count = Count + 1
'If InStr(strArr(i, 1), str) > 0 Then Count = Count + 1
Next
Cell.Value2 = Count
Next
Set Cell = Nothing
Set wb = Nothing
End Sub
Note that str = strArr(i, 1) will match only full value in cells, while InStr(strArr(i, 1), str) > 0 will also match parts in cells. Let's say you are looking for "AAA" in cell with the value "AAAB". The first method will not add additional 1 to the Count, while the second method will.

Possible combinations of values

I'm trying to adapt the Sub + Function from this thread to my need:
write all possible combinations
Tim Williams solution.
It works fine since all columns have at least 2 values. I'm after if there is a workaround to make it work even if some of the columns have just one value in it.
In the Sub command I could change to
col.Add Application.Transpose(sht.Range(Cells(3, c.Column), Cells(Rows.Count, c.Column).End(xlUp)))
and it goes fine.
But the Function is crashing at this line:
ReDim pos(1 To numIn)
just when processing the column that has just one value in it.
Thaks in advance for any help.
I have a more elegant solution with following assumptions:
The data and write to cells are on the same activesheet
Start combination from a cell you specify and going downward then right
Stops going rightward as soon as the cell of the same row is empty
writes the combination from a cell you specify going downwards
Screenshots after the code (Bug fixed on 1 row only on a data column):
Private Const sSEP = "|" ' Separator Character
Sub ListCombinations()
Dim oRngTopLeft As Range, oRngWriteTo As Range
Set oRngWriteTo = Range("E1")
Set oRngTopLeft = Range("A1")
WriteCombinations oRngWriteTo, oRngTopLeft
Set oRngWriteTo = Nothing
Set oRngTopLeft = Nothing
End Sub
Private Sub WriteCombinations(ByRef oRngWriteTo As Range, ByRef oRngTop As Range, Optional sPrefix As String)
Dim iR As Long ' Row Offset
Dim lLastRow As Long ' Last Row of the same column
Dim sTmp As String ' Temp string
If IsEmpty(oRngTop) Then Exit Sub ' Quit if input cell is Empty
lLastRow = Cells(Rows.Count, oRngTop.Column).End(xlUp).Row
'lLastRow = oRngTop.End(xlDown).Row ' <- Bug when 1 row only
For iR = 0 To lLastRow - 1
sTmp = ""
If sPrefix <> "" Then
sTmp = sPrefix & sSEP & oRngTop.Offset(iR, 0).Value
Else
sTmp = oRngTop.Offset(iR, 0).Value
End If
' No recurse if next column starts empty
If IsEmpty(oRngTop.Offset(0, 1)) Then
oRngWriteTo.Value = sTmp ' Write value
Set oRngWriteTo = oRngWriteTo.Offset(1, 0) ' move to next writing cell
Else
WriteCombinations oRngWriteTo, oRngTop.Offset(0, 1), sTmp
End If
Next
End Sub