Check that all values in a range are identical - vba

I need to display a message box when all the values in a range on my spreadsheet are zero. Currently I am using the following code:
Dim Cell As Range
For Each Cell In Range("E17:E25")
If Cell.Value = "0" Then
MsgBox ("If hardware is required, please manually populate the corresponding sections.")
End If
Next
The message is displayed, however it is shown 9 times (for each of the cells in the range). What I need is to check if all the values in the range E17:E25 are zero, and then display only one message box. Any ideas?
Thanks.

You want to know if all the values are 0? You could just do
If WorksheetFunction.Sum(Range("E17:E25")) = 0 Then MsgBox ("If hardware is required, please manually populate the corresponding sections.")
No need for loops.
Edit: If you want to check for any other number, and if all cells are that number, you can do this:
Sub t()
Dim rng As Range
Dim myNum as Long
myNum = 1
Set rng = Range("B3:B6")
If WorksheetFunction.CountIf(rng, myNum) = rng.Count Then MsgBox ("All the same!")
End Sub

And cause there are infinite ways to skin a cat here is another approach.
Dim Cell As Range
Dim ZeroCount As Integer
Dim CellCount As Integer
ZeroCount = 0
CellCount = 0
For Each Cell In Range("E17:E25")
CellCount = CellCount + 1
If Cell.Value = 0 Then ZeroCount = ZeroCount + 1
Next Cell
If ZeroCount = CellCount Then MsgBox ("If hardware is required, please manually populate the corresponding sections.")

To test that:
The range doesn't contain any empty values
All cells are the same
function
Function SameRange(rngIn As Range) As Boolean
If Application.CountA(rngIn) = rngIn.Cells.Count Then SameRange = (Application.CountIf(rngIn, rngIn.Cells(1).Value) = rngIn.Cells.Count)
End Function
test
Sub test()
MsgBox SameRange([d1:d5])
End Sub

'something like this
Dim isDataPresent as boolean
isDataPresent = true
for each Cell in Range(....)
if cell.value = "0" then
isDataPresent = false
exit for
end if
next
if not isDataPresent then
show message box here
end if

Related

vba counter that takes value from different cell on each loop

I have solved this problem myself thanks to the people who offered help
I have an if statement which relies on a counter, I am taking the value of the counter from cell "B3" and the code works fine as it is.
However each time I loop through the program I need the counter to take it's value from a different cell.
so for example loop 1 read value from "B3"
loop 2 read value from "C3"
next "D3" and so on across the sheet
keep going until it reaches a an empty cell
I have dim c as integer
and for c= 2 to 26 to take me to the 26th column
but I am not sure how to get it to increment each time the loop starts. can anyone help with this? I can post the full code I am using at the moment if that will help the understanding of the question
Public Sub copyX()
Dim listofcells As Range
Dim currentname As String
Dim foundrow As Integer
Dim foundcolumn As Integer
Dim counter As Integer
Dim i As Integer
Dim c As Integer
For i = 2 To 26
Sheets("Availability").Activate
counter = Range("b3")
Sheets("Availability").Range("a2").Select
If Not Sheets("Availability").Cells(2, i) = "" Then
Sheets("Availability").Range(Cells(2, i), Cells(2, i).End(xlDown)).Select
Else
GoTo skip: 'If the column has no data then skip to next column
End If
Set listofcells = Selection
Sheets("allocation").Activate
Range("a2").Select
For Each singlecell In listofcells
If counter > 0 Then
If singlecell = "Available" Then
foundcolumn = singlecell.Column 'record the column number where "Available" was found
currentname = Sheets("availability").Range("A" & singlecell.Row) 'record the name of the person in the row where "Available" was found
Set foundName = Sheets("allocation").Range("A:A").Find(What:=currentname, LookIn:=xlValues) 'find the persons name in "Allocation" sheet
foundrow = foundName.Row
Sheets("allocation").Cells(foundrow, foundcolumn) = "X" 'place yes in the same cell as it appeared in "Availability" sheet
counter = counter - 1
End If
End If
Next singlecell
skip:
Next i
End Sub
I have come up with the following code which does go through the cells and get their value, the problem is I can not get a for next loop to work inside another for next loop.
Set counterrange = Range("b3:Z3")
For Each cell In counterrange
Next cell
Try with this concept ...
modify your code to
Dim k as Integer
k=3;
counter =Range(Cells(3, k), Cells(3, k)).Value // through this you will get dynamic counter value like B3,D3,E3.,,,,
if(counter !="")
{
//execute some code
}
k=k+1;

VBA Array doesn't work?

I have this practice file with 5 order prices. The goal is to add $20 to each of the record and have a message box to display the result.
Here is the data:
My code is this:
Sub TotalDelivery()
Dim curDelCharge As Currency
Dim curTotal(4)
Dim i As Integer
Worksheets("Sheet1").Range("B10").Activate
Const curDelCharge = 20
For i = 0 To 4
curTotal(i) = ActiveCell.Offset(i, 1).Value + curDelCharge
MsgBox (curTotal(i))
Next i
End Sub
However the message box only displays 20 which is only my curDelCharge value.
To debug, I change the msgbox code into:
MsgBox (ActiveCell.Offset(i, 1).Value)
The return value is blank which means the code doesn't read my ActiveCell value. Why is that?
Thanks in advance!
This line:
curTotal(i) = ActiveCell.Offset(i, 1).Value + curDelCharge
should instead be:
curTotal(i) = ActiveCell.Offset(i, 0).Value + curDelCharge
Putting a "1" will move the offset 1 column to the right, which you don't want.
Sub TotalDelivery()
Dim curTotal(4)
Dim i As Integer
Dim rngCellsToChange As Range 'range of cells you are targeting
Dim rCell As Range 'individual cell in collection of cells. See alternative solution below
'You can refer to cells directly, without activating them.
'You are highly discouraged to use Activate or Select methods.
'Use ThisWorkbook to explicitly tell VBA, which workbook you are targeting
Set rngCellsToChange = ThisWorkbook.Worksheets("Sheet1").Range("B10:B14")
Const curDelCharge = 20
For i = 0 To 4
curTotal(i) = rngCellsToChange(i + 1).Value + curDelCharge
MsgBox (curTotal(i))
Next i
'Alternatively, you can use the Range object to loop through all it's cells, like so:
For Each rCell In rngCellsToChange
MsgBox rCell.Value + curDelCharge
Next
End Sub

finding the lowest value in a cell Excel 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

How do I make value static in last row value?

Here is the code below:
Public n as Long ' <--above sub procedure
With Sheets("Sheet1").Range("A6").Offset(n, 0)
If n = 0 Then
.Value = 1
Else
.Value = .Parent.Range(.Address).Offset(-1, 0) + 1
End If
n = n + 1
End With
(See pic below) If I delete 4 then click command button again it just reset back to 1. I want to make it static so even I deleted the last value of row it still continue increment from the last value.
Store number
1
2
3
4
Try this:
Sub Test()
Dim trow As Long
With Sheets("Sheet1") '~~> change to suit
trow = .Range("A:A").Find(vbNullString, [A5]).Row
With .Range("A" & trow)
If trow = 6 Then .Value = 1 _
Else .Value = .Offset(-1, 0).Value + 1
End With
End With
End Sub
Above code finds the first blank cells. If it is A6 it assigns a value of 1.
Otherwise it assigns previous cell value plus 1. Is this what you're trying?
Edit1: Explanation
trow = .Range("A:A").Find(vbNullString, [A5]).Row
This finds the first empty row in Column A starting A5.
[A5] is used to return Range("A5") object. So it can also be written as:
trow = .Range("A:A").Find(vbNullString, .Range("A5")).Row
We used a VBA vbNullString constant as What argument in Range Object Find Method.
Find Method returns a Range Object so above can be written also like this:
Sub Test()
Dim r As Range
With Sheets("Sheet1") '~~> change to suit
Set r = .Range("A:A").Find(vbNullString, [A5])
With r
If .Row = 6 Then .Value = 1 _
Else .Value = .Offset(-1, 0).Value + 1
End With
End With
End Sub
What your asking for, a button with memory doesn't sound neatly solvable using just VBA.
You could potentially have a list on a hidden sheet that gets a value added to it each time the commandButton is pressed and it writes the max of the list values back to the target cell?
Alternatively you could investigate using a scrollbar from the form control section of the developer tab with a link to your target cell. I often use this technique for interactive sheets.
Named Range Method
Public sub btnPress
dim val as long
val = Range("PreviousCellValue")
set Range("PreviousCellValue") = val+1
Sheets("Sheet1").Range("A6").Offset(n, 0).value = Range("PreviousCellValue")
End sub btnPress

Excel VBA: Use variable containing cell-index in a range

I am very new to macros, so this is probably a dumb question. I have searched and searched, and have not yet found the answer, so I hope an expert in here will aid me :)
In my code I have a large range that I search through for a certain trait (all cells have either the values "Done", "Ongoing" or "Waiting"). When I find the value "Ongoing", I want to use that cell to create a smaller range, that I will use a counter in. I can, however, not make the subrange work :(
Dim range1 As Range
For Each cell In Sheet2.Range("A5:Y5")
If cell.Value = "Ongoing" Then Set range1 = Cells(cell.Row, cell.Column)
Next cell
i = 0
For Each cell In Sheet2.Range("A5:range1")
If cell.Value = "Done" Then
i = i + 1
End If
Next cell
Here you have a simple code performing some of the actions you want:
Dim rangeToSearch As Range
Dim doneCount As Integer, onGoingCount As Integer, onGoingDones(50) As Integer
Set rangeToSearch = Sheet2.Range("A5:Y5")
doneCount = 0
onGoingCount = 0
For Each cell In rangeToSearch
If (Not IsEmpty(cell)) Then
If LCase(cell.Value) = "done" Then
doneCount = doneCount + 1
ElseIf LCase(cell.Value) = "ongoing" Then
onGoingCount = onGoingCount + 1
onGoingDones(onGoingCount) = doneCount
doneCount = 0
End If
End If
Next cell
It counts the number of "done" (caps does not matter) between "ongoing" cells and store them in an array (onGoingDones; it can just deal with upto 50 elements, but I guess that is more than enough).