conecting a function with a database

**bopp** · 2011-04-27, 10:43 AM

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** · 2011-04-27, 03:17 PM

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

Sent from my LG-E900h using Board Express

**bopp** · 2011-04-27, 04:04 PM

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** · 2011-04-27, 05:08 PM

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** · 2011-04-29, 02:07 PM

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

Originally Posted by 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.

Code:

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

Code:

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

Code:

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

Code:

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** · 2011-04-29, 05:09 PM

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

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

**bopp** · 2011-04-30, 09:20 PM

hahaha my parents are from Spain, thats why :P. It will be great if you could help me, I'm so lost

, I really appreciate your help. Thank you very much and don't worry when ever you have time.

**Ken Puls** · 2011-05-02, 10:22 PM

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.)