I am trying to sum up all of the random integer values over 500 and then present them in a text box, however it is not working and whenever I run the code, it sums to zero. This is inside of a user form using VBA. Any suggestions would be appreciated.
Private Sub CommandButton1_Click()
Dim r As Double, c As Double, rand As Double, y As Double, x As Double, i As Double
r = TextBox1.Value
c = TextBox2.Value
rand = TextBox3.Value
Rnd [5]
i = 0
For x = 1 To r
For y = 1 To c
Cells(x, y).Value = Int(Rnd * rand)
If (ActiveCell.Value >= 500) Then
i = i + ActiveCell.Value
Else ' do nothing
End If
Next y
Next x
Cells(r + 1, c).Value = "SUM"
Cells(r + 1, c + 1).Value = i
MsgBox (i)
End Sub
I don't know much about VBA, but could
Cells(x, y).Value = Int(Rnd * rand)
If (ActiveCell.Value >= 500) Then
.. be referring to different cells?
Related
I am trying to calculate the result of a formula using this code but for some reason i can't figure out why it is not printing in the loop...
Sub findx()
Dim A, B, fct As Variant
Dim k, i As Long
fct = InputBox("What is the function in terms of x?")
A = InputBox("Set lower boundary")
B = InputBox("Set upper boundary")
i = InputBox("How many times would you like to repeat this algorithm?")
Range("A6").Value = A
Range("B6").Value = B
For k = i To k = i + 6
Cells(k, 5).Value = "=" & Replace(LCase(fct), "x", Cells(k, 1).Value)
k = k + 1
Next
End Sub
UDF aim: Compare the value of the range with the specific cells on the same sheet.
Error occurs #Value!.
I think , that the problem in setting the pass to this cell ThisWorkbook.ThisWorksheet. How to do it competently?
Function Fav(Diapozon As Range) As Long
Application.Volatile
Dim n As Long
For x = 1 To 4
For y = 0 To 1
If Diapozon.Value = ThisWorkbook.Thisworksheet.Cells(x + 29, y + 10).Value Or _
Diapozon.Offset(0, 1).Value = ThisWorkbook.Thisworksheet.Cells(x + 29, y + 10).Value Then
n = 1
End If
Next y
Next x
Fav = n
End Function
Correct. Perhaps you meant Activesheet?
Public Function Fav(ByVal Diapozon As Range) As Long
Application.Volatile
Dim n As Long, x As Long, y As Long
For x = 1 To 4
For y = 0 To 1
If Diapozon.Value = ThisWorkbook.ActiveSheet.Cells(x + 29, y + 10).Value Or Diapozon.Offset(0, 1).Value = ThisWorkbook.ActiveSheet.Cells(x + 29, y + 10).Value Then
n = 1
End If
Next y
Next x
Fav = n
End Function
If you are using this only in the sheet as an UDF then drop the sheet reference:
Public Function Fav(ByVal Diapozon As Range) As Long
Application.Volatile
Dim n As Long, x As Long, y As Long
For x = 1 To 4
For y = 0 To 1
If Diapozon.Value = Cells(x + 29, y + 10).Value Or Diapozon.Offset(0, 1).Value = Cells(x + 29, y + 10).Value Then
n = 1
End If
Next y
Next x
Fav = n
End Function
What I am trying to do is develop a model that takes a cell that is greater than 1 then to take the sum of the area to the first row using a cone shape, so for example cell D4, sum the area C3:C5 + B2:B6 + A1:A7.
At the moment I have this but it obviously is not working.
Dim I As Double
Dim J As Double
Dim Size As Integer
Dim x As Integer
Dim y As Integer
Dim z As Integer
'Dim Range As Integer
Dim PV1 As Integer
'MCArray = Worksheets("Data")
I = WorksheetFunction.CountA(Worksheets("Data").Rows(1))
J = WorksheetFunction.CountA(Worksheets("Data").Columns(1))
'Loop to Move down the rows
For x = 1 To J
'Loop to move acoss the columns
For y = 1 To I
'IfElse to determine if cell value is greater or equal to zero
If Cells(J, I).Value >= 0 Then
'Loop to sum the cells above
For z = 1 To J
PV1 = (ActiveCell.Value) + Worksheet.Sum(Range([J - z], [I-z:I+z]))
'IfElse to determine if final sum is greater than zero
If PV1 > 0 Then
Worksheets("MC").Range("B4").Value = PV1
Range([J - z], [I-z:I+z]).Interior.ColourIndex = 1
End If
Next z
End If
Next y
Next x
Here is a function you can use either as a UDF or from another routine. Just pass it the single cell you want to start from (D4 in your example) and this function will calculate the sum of the cone as you described.
Public Function SUMCONE(r As Range) As Double
Application.Volatile
SUMCONE = Application.Sum(r, r(-0, -0).Resize(, 3), r(-1, -1).Resize(, 5), r(-2, -2).Resize(, 7))
End Function
Here is an example of how to use the above function from your VBA routine:
Public Sub Demo()
Dim j&
For j = 5 To 10
If Cells(5, j) > 0 Then
Debug.Print SUMCONE(Cells(5, j))
End If
Next
End Sub
UPDATE
Based on your feedback I have updated the function and the demo routine to form an upward cone summation from the initial cell.
UPDATE #2
The above is for a fixed-size cone, extending upwards, that can be initiated from any cell in the worksheet.
But if you would prefer for the cone to always extend all the way up to row 1 regardless of which cell it originates in, then the following is what you are after:
Public Sub Demo()
Dim i&, j&
For j = 1 To Application.CountA(Worksheets("Data").Rows(1))
For i = 1 To Application.CountA(Worksheets("Data").Columns(1))
If Cells(i, j) > 0 Then
Debug.Print Cells(i, j).Address, SumAndColorCone(Cells(i, j))
End If
Next
Next
End Sub
Public Function SumAndColorCone(r As Range) As Double
Dim i&, k&, c As Range
Set c = r
For i = r.Row - 1 To 1 Step -1
Set c = Union(c, r(-k, -k).Resize(, (k + 1) * 2 + 1))
k = k + 1
Next
c.Interior.Color = vbRed
SumAndColorCone = Application.Sum(c)
End Function
UPDATE #3
As I suspected there was a problem if the cone was initiated too close to the left edge of the worksheet. I've added code to handle that now. Also your method for accessing the large matrix (which I had used in the Demo routine) did not work properly. I fixed that as well:
Public Sub Demo()
Dim i&, j&
For j = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
If Val(Cells(i, j)) > 0 Then
Debug.Print Cells(i, j).Address, SumAndColorCone(Cells(i, j))
End If
Next
Next
End Sub
Public Function SumAndColorCone(r As Range) As Double
Dim i&, k&, c As Range
Set c = r
For i = r.Row - 1 To 1 Step -1
If r.Column - k < 2 Then Exit For
Set c = Union(c, r(-k, -k).Resize(, (k + 1) * 2 + 1))
k = k + 1
Next
c.Interior.Color = vbRed
SumAndColorCone = Application.Sum(c)
End Function
I have been working on this code for a while. As you can see after the code line " With ws(2)" there is an if condition. Now, I have multiple to create multiple such If conditions such as for 0.6, 0.7, 0.8 etc. (and each such condition should use a different table of data) {I am posting the excel file link for the tables as well so that you can get an idea} Can I do this using a function or any method which wont require me to write this code again and again for each new condition ?
https://docs.google.com/file/d/0B1DVNSutDHR0QWd2UUJsVDZ1Tm8/edit
Private Sub CommandButton1_Click()
Dim x(1 To 9000) As Double, y(1 To 9000) As Double, x1 As Double, y1 As Double, x2 As Double, y2 As Double, I1(1 To 9000) As Double, I2(1 To 9000) As Double, R1(1 To 9000) As Double, R2(1 To 9000) As Double, a As Double, b As Double, c As Double, d As Double, Result(1 To 9000) As Double
Dim i As Integer, j As Integer, k As Integer, p As Integer, q As Integer, r As Integer, s As Integer, t As Integer
Dim ws As Sheets
Set ws = ActiveWorkbook.Sheets(Array("Sheet1", "PLP-1", "PLP-2"))
For t = 0 To 120 Step 20
For k = 1 To 9000
With ws(1)
I1(k) = .Cells(k + 2, 13).Value
I2(k) = .Cells(k + 2, 14).Value
End With
With ws(2)
Select Case .Cells(6 + t, 1).Value
Case 0.5:
r = 0
s = 0
Case 0.6:
r = 20
s = 1
Case 0.7:
r = 40
s = 2
Case 0.8:
r = 60
s = 2
Case 0.9:
r = 80
s = 3
Case 1:
r = 100
s = 4
Case 1.1:
r = 120
s = 5
End Select
For i = 7 To 22
If (.Cells(i + r, 1).Value <= I1(k)) And (I1(k) <= .Cells(i + r + 1, 1).Value) And Not (IsEmpty(I1(k))) Then
p = i + r
x(k) = I1(k)
x1 = .Cells(i + r, 1).Value
x2 = .Cells(i + r + 1, 1).Value
End If
Next i
For j = 2 To 8
If (.Cells(6 + r, j).Value <= I2(k)) And (I2(k) <= .Cells(6 + r, j + 1).Value) And Not (IsEmpty(I2(k))) Then
q = j + r
y(k) = I2(k)
y1 = .Cells(6 + r, j).Value
y2 = .Cells(6 + r, j + 1).Value
End If
Next j
If p <> 0 And q <> 0 Then
a = .Cells(p, q).Value
b = .Cells(p, q + 1).Value
c = .Cells(p + 1, q).Value
d = .Cells(p + 1, q + 1).Value
End If
If I1(k) = Empty Then
R1(k) = 0
Else
R1(k) = (((y2 - y(k)) / (y2 - y1)) * a) + (((y(k) - y1) / (y2 - y1)) * b)
End If
If I2(k) = Empty Then
R2(k) = 0
Else
R2(k) = (((y2 - y(k)) / (y2 - y1)) * c) + (((y(k) - y1) / (y2 - y1)) * d)
End If
Result(k) = (((x2 - x(k)) / (x2 - x1)) * R1(k)) + (((x(k) - x1) / (x2 - x1)) * R2(k))
End With
With ws(1)
.Cells(k + 2, 15 + s).Value = Result(k)
End With
Next k
Next t
End Sub
Try using a Select Case statement as below:
Dim iStart As Long, iEnd As long, jStart As Long, jEnd As Long
'...
With ws(2)
Select Case .Cells(6, 1).Value
Case 0.5:
iStart = 7: iEnd = 22
jStart = 2: jEnd = 7
Case 0.6:
'Same as above but substitute new values for iStart etc.
End Select
For i = iStart To iEnd
'DO STUFF WITH i
Next i
For j = jStart To jEnd
'DO STUFF WITH j
Next j
End With
EDIT: Updated to reflect needs clarified in comments
A more in-depth explanation and usage guide for Select Case can be found here
With regard to your looping, if I understand your code, you need to loop through each "table", but your I and J refer to absolute addresses. What you want is to have I and J be relative to the desired table.
I just used values of 2 to 7, but if the tables are different sizes, you could certainly determine that with code; or even read them into a variant array and do your testing on the array (would often be faster).
So something like the following (pseudo code)
Option Explicit
'N is the Value that defines the proper table
Function DoYourThingOnProperRange(N As Double)
Dim C As Range
Dim I As Long, J As Long
With Sheet1.Columns(1)
Set C = .Find(what:=N, after:=Sheet1.Cells(Rows.Count, "A"), LookIn:=xlValues, _
lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlNext)
If Not C Is Nothing Then
Set C = C.CurrentRegion 'C is now set to the proper table
'DoYourThing
'Here's just a dummy routine
For I = 2 To 7
For J = 2 To 7
Debug.Print C(I, J).Address
Next J
Next I
Else
'some kind or error routine for non-existent table
End If
End With
End Function
Hey guys I am new to VBA for excel and I am stuck with a problem.
I am trying to do some calculations for data input and I have to make my program stop displaying values on the worksheet before "Discrepancy" reaches any less than 5. This then should make both columns "Money" and "Discrepancy" stop together. After, the program will then start in another column (column "I1" for "Money2" and J1" for "Discrepancy2") when t=10 is inputted into the formula and the values are displayed in Columns I2 and J2 until till the end.
I'm not sure how to stop it before it reaches and also how to stop the other column simultaneously. I'm also not sure if it will continue for another t=10.
Any advice
Sub solver2()
Dim t As Double, v As Double, i As Integer
Dim rowG As Integer, rowH As Integer
i = 0: v = 0 'related to formuala
'Range("A3").Select
'Range("D3").Select
Range("G1").Value = "Money"
Range("H1").Value = "Discrepancy"
Range("G2").Select
For t = 0 To tf Step delta
ActiveCell.Offset(i, 0) = t
ActiveCell.Offset(i, 1) = v
v = v + delta * accel(t, v)
i = i + 1
Next t
rowG = ActiveSheet.Range("G2").End(xlDown).row
rowH = ActiveSheet.Range("H2").End(xlDown).row
For i = rowG To 1 Step -1
Dim val1 As Long
val1 = ActiveSheet.Range("G" & i).Value
If (val1 > 5) Then
ActiveSheet.Range("G" & i).EntireRow.Delete
End If
Next i
For i = rowH To 1 Step -1
Dim val2 As Long
val2 = ActiveSheet.Range("G" & i).Value
If (val2 > 5) Then
ActiveSheet.Range("G" & i).EntireRow.Delete
End If
Next i
For t = 0 To 10 Step delta 'This steps it per delta input
Range("I1").Value = "Money2"
Range("J1").Value = "Discrepancy2"
Range("I2").Select
ActiveCell.Offset(i, 0) = t
ActiveCell.Offset(i, 1) = v
v = v + delta * accel(t, v)
i = i + 1
Next t
End Sub
If you just need the cells to appear empty, you could use conditional formatting to set the text and background colors the same.
You might try a do while loop instead of a for loop to set the values in the first set:
Do While t <= tf And v < 5
ActiveCell.Offset(i, 0) = t
ActiveCell.Offset(i, 1) = v
v = v + Delta * accel(t, v)
i = i + 1
t = t + Delta
Loop
I'm not sure what you intended for the other columns, but this loop would leave t at the value you would use if you mean to continue where the first column left off