I can't work out why a simple vba code won't increment a variable. Any help would be greatly appreciated
Sub regression_coeff()
Dim x1 As Integer, x2 As Integer, i As Integer
Dim inc As Integer
inc = 1
x1 = 1
x2 = 1
For i = 0 To 10
x2 = x2 + 1
Next i
End
'x1 = x1 / x
'x2 = x2 / x
Cells(1, 3).Value = x1
'Cells(1, 4).Value = x2
End Sub
I thought it might be due to the variable definition but it didn't help
Cheers
D
Option Explicit
Sub regression_coeff()
Dim x1 As Integer, x2 As Integer, i As Integer
Dim inc As Integer
inc = 1
x1 = 1
x2 = 1
For i = 0 To 10
x2 = x2 + 1
Next i
'x1 = x1 / x
'x2 = x2 / x
Cells(1, 3).Value = x1
Cells(1, 4).Value = x2
End Sub
It works by me like this. The problem with your code was the End, which stops it. Here is a bit more about END.
Related
I have a problem looping through a sheet to find a row matching some variables.
I've got 8 columns per row, and I want to find a row that contains 6 variables, one empty cell and one cell with value 0. Like this:
- | A | B | C | D | E | F | G | H |
i | x1 | | x2 | 0 | x3 | x4 | x5 | x6 |
Where i is a row number and x1, x2,.. x6 are variables obtained from a CSV file. I want to check if my 'list' of variables {x1, ,x2,0,x3,x4,x5,x6} is an existing row in a sheet. So I want the program to do something If (Ai = x1 And Bi = "" And Ci = x2 And Di = "0" And Ei = x3 And Fi = x4 And Gi = x5 And Hi = x6) and do nothing when Else.
So I need to loop through all the rows and check if all variables are in 1 row.
At the moment I tried this but it doesn't seem to work.
LastCol = 8
LastRow = ThisWorkbook.Sheets("Boekingen AMS-IAD").Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LastRow
For j = 1 To LastCol
'Tried with only 1 criteria, still didn't work
If (ThisWorkbook.Sheets("Boekingen AMS-IAD").Cells(i, j).Value = x1) Then
Accept = "nvt"
End If
Next j
Next i
You can try something like this. I left everything pretty much as you had it with a couple of exceptions.
lastcol = 8
Dim vars
ReDim vars(1 To lastcol)
'Set vars() to the values you're looking for in the columns.
LastRow = ThisWorkbook.Sheets("Boekingen AMS-IAD").Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LastRow
accept = ""
met = 0
For j = 1 To lastcol
With ThisWorkbook.Sheets("Boekingen AMS-IAD").Cells(i, j)
If .Value = vars(j) Then
met = met + 1
End If
End With
Next j
If met = lastcol Then accept = "nvt"
'At this point you have to do something with the row you just
' found--maybe leave the loop and do something, or do something
' before going to the next row.
Next i
I made this quick little test sub in a new excel folder, renamed Sheet1 to your sheet's name and it works excellently:
Sub testing()
Dim ws As Worksheet
Dim rng As Range
Set ws = ThisWorkbook.Sheets("Boekingen AMS-IAD")
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
For i = 1 To LastRow
If ws.Cells(i, 1).Value = x1 And _
ws.Cells(i, 2).Value = "" And _
ws.Cells(i, 3).Value = x2 And _
ws.Cells(i, 4).Value = "0" And _
ws.Cells(i, 5).Value = x3 And _
ws.Cells(i, 6).Value = x4 And _
ws.Cells(i, 7).Value = x5 And _
ws.Cells(i, 8).Value = x6 Then
'MsgBox "nvt at row " & i
Accept = "nvt"
End If
Next i
End Sub
This should spit out "nvt" when the line follows your variables :)
PS - anyone looking to test this code, you just need to add the following under Dim rng as Range:
Dim x1 As Integer
Dim x2 As Integer
Dim x3 As Integer
Dim x4 As Integer
Dim x5 As Integer
Dim x6 As Integer
x1 = 1
x2 = 1
x3 = 1
x4 = 1
x5 = 1
x6 = 1
I fixed the issue, the problem wasn't in looping through the sheet, but in a value of a variable. The date was changed from D-M-Y to M-D-Y when I read it from the Excel sheet. But I fixed that, for the ones that are interested in the answer: VBA changes date format from D-M-Y to M-D-Y
I previously asked a question on VBA code to overwrite cells through moving /shifting up a range of cells and i got an answer which met my needs. However i realised that i had to hard code all the ranges for each table to perform this vba function which is risky as the cell alignments often change in the sheet.. Thus i want an input box that allows user to select the table of cells they want to perform this function .I know how an input box works however the given code goes by rows and columns, something of which the range that the user selects, does not contain . Thus is there anyways for an input box to work in this code without having to hardcode? Or are there any other alternatives to avoid hardcording in this code and have it work based on the user selection basis? All of your help would be very much appreciated.
Improvised on the given answer but i am still getting a type mismatch error. Why is that so?
Sub Macro1()
Dim y1 As Variant
Dim y2 As Variant
Dim x1 As Variant
Dim x2 As Variant
y1 = Application.InputBox("Input First Row", Type:=8)
y2 = Application.InputBox("Input End Row", Type:=8)
x1 = Application.InputBox("Input First Column", Type:=8)
x2 = Application.InputBox("Input End Column", Type:=8)
Dim sh As Worksheet
Dim x As Long, y As Long
Set sh = ActiveSheet ' or the specific sheet
' The 12 months
For y = y1 To y2
' Your 7 columns
For x = x1 To x2
sh.Cells(y, x) = sh.Cells(y + 1, x)
Next x
Next y
'With sh.Cells(y2, 1)
'.Select
' This only works if your column A contains dates (not strings)
'.Value = DateAdd("m", 1, sh.Cells(y2 - 1, 1))
' End With
End Sub
Extending the accepted answer from your last question you could do something like this:
That way the User can select the range it acts on using input boxes?
Dim y1 As Variant
Dim y2 As Variant
Dim x1 As Variant
Dim x2 As Variant
Dim cell1 As Integer
Dim cell2 As Integer
y1 = Application.InputBox("Input First Row")
If y1 = "" Or y1 = False Then GoTo handleNull
y2 = Application.InputBox("Input End Row")
If y2 = "" Or y2 = False Then GoTo handleNull
x1 = Application.InputBox("Input First Column")
If x1 = "" Or x1 = False Then GoTo handleNull
x2 = Application.InputBox("Input End Column")
If x2 = "" Or x2 = False Then GoTo handleNull
cell1 = y2 - 1
cell2 = x1
Dim sh As Worksheet
Dim x As Long, y As Long
Set sh = ActiveSheet ' or the specific sheet
' The 12 months
For y = y1 To y2
' Your 7 columns
For x = x1 To x2
sh.Cells(y, x) = sh.Cells(y + 1, x)
Next x
Next y
With sh.Cells(y2, 1)
.Select
' This only works if your column A contains dates (not strings)
.Value = DateAdd("m", 1, sh.Cells(cell1, cell2))
End With
handleNull:
End
This will operate on the selected range:
Selection.Value = Selection.Offset(1,0).Value
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
I am new to VBA and I wanted to write down a simple piece of code for implementing a double summation of binomial distribution product. The code I have written is:
Sub reactiveTransshipment()
Dim i As Integer
i = 0
Dim j As Integer
j = 0
Dim y1 As Integer
y1 = 1037
Dim y2 As Integer
y2 = 1037
Dim PI1 As Double
PI1 = 0
Dim PI1_1 As Double
PI1_1 = 0
Dim PI1_2 As Double
PI1_2 = 0
Dim k1 As Double
Dim k2 As Double
Dim n As Integer
n = 2000
Dim P As Double
P = 0.5
For j = 0 To (y2 - 1)
For i = (y1 + 1) To (y1 + y2 - j)
k1 = WorksheetFunction.BinomDist(i, n, P, False)
k2 = WorksheetFunction.BinomDist(j, n, P, False)
PI1_2 = PI1_2 + (k1 * k2)
Next i
Next j
Worksheets(2).Range("D2").Value = k1
End Sub
I am trying to run Rungenkutta differential problem in excel VBA
program is as follows
Sub Rungenkutta()
Dim Noofitrations As Integer
Dim n As Integer
Dim ii As Integer
Noofitrations = Cells(2, 10)
n = Cells(3, 10)
h = Cells(3, 4)
col = 8
x0 = Cells(col, 9)
y0 = Cells(col, 10)
For i = 1 To Noofitrations
Cells(7, 3) = x0
Cells(7, 4) = y0
xn = x0 + h
yn = y0 + Cells(18, 3)
ii i Mod n
If ii = 0 Then
col = col + 1
Cells(col, 9) = xn
Cells(col, 10) = yn
End If
x0 = xn
y0 = yn
Next
End Sub
but while running I am getting "VBA excel compile error : Expected Sub,Function, or property"
I am not understanding what shall i do to run the program
Your problem is with the Mod operator. VBA doesn't recognize the syntax you provided.
Here is some documentation for the Mod operator - http://msdn.microsoft.com/en-us/library/se0w9esz.aspx
Th Mod operator is a binary operator and requires one left and one right argument.
You need to change
ii i Mod n
to
ii = i Mod n
Here is the revised example you provided.
Sub Rungenkutta()
Dim Noofitrations As Integer
Dim n As Integer
Dim ii As Integer
Noofitrations = Cells(2, 10)
n = Cells(3, 10)
h = Cells(3, 4)
col = 8
x0 = Cells(col, 9)
y0 = Cells(col, 10)
For i = 1 To Noofitrations
Cells(7, 3) = x0
Cells(7, 4) = y0
xn = x0 + h
yn = y0 + Cells(18, 3)
ii = i Mod n
If ii = 0 Then
col = col + 1
Cells(col, 9) = xn
Cells(col, 10) = yn
End If
x0 = xn
y0 = yn
Next
End Sub