conecting a function with a database

[bopp]

Hello!

First sorry for my english I am from switzerland.
I have a huge problem(for me) that i cannot solve and if you can help me I'll be forever grateful.

The think Is, I wanna make a function that have 2 konstant values but the thing is this values depends on the kind of chosen product. I have solved with select case but the thing is, that is necessary to change sometimes and I would like to have these constant values in a external excel.

But for this I don't know how to get the values(from external closed excel) into the variables inside the function. Have to be a function in order to have the quality of handling.

I have tried with many things but the biggest problem Is that I have to be able to make a lookup inside this database and take the value from oder column

If you need more dates just ask me about

thanks for your help

[Ken Puls]

Welcome! What kind of database are you pulling from exactly?

Sent from my LG-E900h using Board Express

[bopp]

Hello!

The database will be other excel of 1 sheet that willl have a table with the dates name, a(value to take), b(value to take).

I was thinking in use VLookup but I dont know, if will be posible because y should activate the workbook & sheet in the other excel, and I don't know how to take the value found for the Function....Or if is posible... jeje

[Ken Puls]

Can you post a set of basic example workbooks? Take out anythind confidential and we'll see if we can come up with an elegant solution. :)

[bopp]

Hello! I was testing 2 diferet ways one I got but the problem is that only runs with the makro not with the Function (taht is the goal) and the oder It's with ADO that I don't really know but I think it goes to the write file but don't take the information.

I post the 2 tries and an example of the database that is inside a excel file in oder hard drive (c:\ for example)
EXAMPLE that runs with makro (easy way) there is a mixture with german and spansh sorry


Can you post a set of basic example workbooks? Take out anythind confidential and we'll see if we can come up with an elegant solution. :)



Function PerdidaPresion(ByVal Dichte As Single, ByVal Geschwindigkeit As Single, ByVal Viskositat As Single, ByVal Parametro As String) As Double
Dim RutaActual, NombreFichero, fic As String
Dim FilaInicial, FilaFinal, fil As Integer
Dim a, b, w, d As Single
Dim solucion, Beta As Double



'calculo el nombre de la base de datos ubicada en la misma carpeta
RutaActual = "C:\Dokumente und Einstellungen\glopez\Desktop\DATOS"
NombreFichero = "KATALOG2.xls"
fic = RutaActual & "\" & NombreFichero

'intento abrir la BD. si no puedo, lanzo una excepcion
On Error GoTo GestionErrores



'abro la BD
Workbooks.Open fic

a = -1
b = -1

FilaInicial = 1
FilaFinal = 256
'busco el parametro en la col1 y extraigo a y b de las cols 2 y 3
For fil = FilaInicial To FilaFinal
If Cells(fil, 1).Value = Parametro Then
a = Cells(fil, 5).Value
b = Cells(fil, 6).Value
Beta = Cells(fil, 7).Value
d = Cells(fil, 4).Value


Exit For
End If
Next

ActiveWorkbook.Close


'si no se encontraron a y b. aplico la formula alternativa
If (a = 0) And (b = 0) Then


MsgBox Beta
MsgBox d

solucion = (((1 - Beta) / (Beta ^ 2)) * (0.72 + ((49 * Beta * Viskositat) / (Dichte * Geschwindigkeit * d * 10 ^ (-6))))) * Dichte * ((Geschwindigkeit ^ 2) / 2) / 10 ^ (5)

PerdidaPresion = solucion


Exit Function
End If

MsgBox a
MsgBox b



'si encuentro a y b aplico la formula principal
solucion = ((((a + ((b * Viskositat) / (Dichte * Geschwindigkeit * 10 ^ (-6)))) * Dichte * ((Geschwindigkeit ^ 2) / 2))) / 10 ^ (5))
PerdidaPresion = solucion


Exit Function



GestionErrores:
MsgBox "No se pudo abrir " & NombreFichero, , "Error " & Err.Number




Exit Function
End Function


Sub probarFormula()
Dim res As Double

res = PerdidaPresion(800, 2, 0.01, "122/90")
Cells(2, 3).Value = res

End Sub

THE SECOND TRY I would like to do in this way or another that you know


Function PerdidaPresion(ByVal Dichte As Single, ByVal Geschwindigkeit As Single, ByVal Viskositat As Single, ByVal Name As String) As Double
Dim RutaActual, NombreFichero, fic As String
Dim FilaInicial, FilaFinal, fil As Integer
Dim a, b, w, d As Single
Dim solucion, Beta As Double

'Geschwindigkeit=velocity Viskositat= viscosity dichte= density



'dimensions
Dim datConnection As ADODB.Connection
Dim recSet As ADODB.Recordset
Dim recCampo As ADODB.Field
Dim strDB, strSQL As String
Dim i As Long

'going to the file in oder folder
strDB = "C:\Dokumente und Einstellungen\glopez\Desktop\DATOS\KATALOG2.xls"

'conecting
Set datConnection = New ADODB.Connection
Set recSet = New ADODB.Recordset

datConnection.Open "DRIVER=Microsoft Excel Driver (*.xls);" & "DBQ=" & strDB


'consulta SQL
'strSQL = "SELECT * FROM [NuestroRango]"
strSQL = "SELECT * FROM [$A1:Q1000]"

'opening the recordset(I don't know if is correct
recSet.Open strSQL, datConnection, adOpenStatic


'Copy dates
a = -1
b = -1
FilaInicial = 1
FilaFinal = 200

'For fil = FilaInicial To FilaFinal

' If Cells(fil, 1).Value = Name Then
' a = Cells(fil, 4).Value
' b = Cells(fil, 5).Value
'Beta = Cells(fil, 6).Value
'd = Cells(fil, 3).Value

'Exit For
'End If
' Next

For fil = FilaInicial To FilaFinal

If Cells(fil, 1).Value = Name Then
a = Cells(fil, 4).Value
b = Cells(fil, 5).Value
Beta = Cells(fil, 6).Value
d = Cells(fil, 3).Value

Exit For
End If

Next


'closing
recSet.Close
datConnection.Close

'close objects

Set recSet = Nothing
Set datConnection = Nothing


'If a & b is 0 I take the oder constant and operate

If (a = 0) And (b = 0) Then


MsgBox Beta
MsgBox d

solucion = (((1 - Beta) / (Beta ^ 2)) * (0.72 + ((49 * Beta * Viskositat) / (Dichte * Geschwindigkeit * d * 10 ^ (-6))))) * Dichte * ((Geschwindigkeit ^ 2) / 2) / 10 ^ (5)

PerdidaPresion = solucion



Exit Function
End If

MsgBox a
MsgBox b



'If I find a & b I make the operation

solucion = ((((a + ((b * Viskositat) / (Dichte * Geschwindigkeit * 10 ^ (-6)))) * Dichte * ((Geschwindigkeit ^ 2) / 2))) / 10 ^ (5))
PerdidaPresion = solucion


Exit Function




GestionErrores:
MsgBox "No se pudo abrir " & NombreFichero, , "Error " & Err.Number




Exit Function
End Function


Sub probarFormula()
Dim res As Double

res = PerdidaPresion(800, 2, 0.01, "20/20")
Cells(1, 3).Value = res

End Sub

EXAMPLE OF DATA BASE

name name W D a b Beta
20/20 20/20 20 20 3 4 0.25
25/25 25/25 25 25 5.211 4 0.25
32/25 32/25 32 25 7.422 4 0.3151739
32/28 32/28 32 28 9.633 4 0.28444444
36/28 36/28 36 28 11.844 4 0.31640625
38/25 38/25 38 25 0 0 0.3638196
40/23 40/23 40 23 0 0 0.40312421
40/25 40/25 40 25 0 2.85 0.37869822
40/28 40/28 40 28 0 2.85 0.34602076
40/32 40/32 40 32 0 2.85 0.30864198
42/36 42/36 42 36 3.9 2.85 0.28994083
45/18 45/18 45 18 3.9 2.85 0.51020408
45/32 45/32 45 32 3.9 2.85 0.34154158
45/36 45/36 45 36 3.9 2.85 0.30864198


Thanks's for your help!!

[Ken Puls]

Wow! From Switzerland coding in German, Spanish and English? :clap2:

I'll have a go at this tonight and see if I can make my way through it. :)

[bopp]

hahaha my parents are from Spain, thats why :P. It will be great if you could help me, I'm so lost :confused2: , I really appreciate your help. Thank you very much and don't worry when ever you have time.

[Ken Puls]

Sorry, haven't been able to get to my computer over the weekend. I'm going to see if I can give this a go tonight/tomorrow night. (I've got a nutty couple of days... month... ahead. Bear with me though, I won't leave you hanging.) :)

[stanly91]

Great post ! I read the post . Thanks for sharing the idea about connecting a function with a database. Post more such creative idea . I like it.

[spinelli]

Many Thanks!!!