CODEWITHSUNDEEP
vbaexcel
dhruva_04
dhruva_04

Reputation: 141

Using function in VBA excel

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

Upvotes: 0

Views: 200

Answers (2)

Aiken
Aiken

Reputation: 2658

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

Upvotes: 2

Ron Rosenfeld
Ron Rosenfeld

Reputation: 60389

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

Upvotes: 1

Related Questions