0

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
Improve this question
1
  • I am still unable to formulate my code. If you see the code and the excel file link I have posted. I have to calculate for 9000 values for 6 different cases(each case uses its own table as its set of data). Also in the code line "for i = 7 to 22" and "for j=2 to 17", these would just apply to the first table(case 0.5) as the values of i and j will change if I want the values for (case 0.6) Commented Jun 26, 2014 at 12:22

2 Answers 2

Reset to default
2

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

Improve this answer
Sign up to request clarification or add additional context in comments.

9 Comments

Hey yeah I can do that. And I am sorry I had forgotten to post the link for my excel file(which I have now). As you see, the different tables are present in the same sheet in different ranges of rows. So for each table the value of "i" and "j" in the code would change.
The answer I gave is mostly just an example of how Select Case could be used to achieve the effect you wanted. You'll obviously have to tailor it to fit individual situations.
Yes I agree. But that won't solve my purpose of shortening the code. As in the Select Case I would still have to type the whole code for the mathematical calculation I am working on.
If the mathematical calculation performs exactly the same calculation but on different source data then the solution would be to write your own VBA function which takes either a Range object or a string referring to a range as an argument. I'll update my answer with an example.
Yes that would be of great help. Thank you :)
|
1

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
Improve this answer

2 Comments

Hey I am super new to VBA..so it went a little above my head. But I was reading upon this find function online. But will this code be able to use different tables for different conditions and then go on to calculate? I have also pasted the link to my excel sheet in the question which might help you understand my problem better. Thanks a ton!
@user3756196 Try it and see how it works. It sets C to the proper table.

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.