Extract data from a database file

Rmrekoj · Sep 8th 2022

Dear Team,

I have a database file that has whole data @attached from that data I simply want an output for that I have discovered a match function that is presently functioning with the same activesheet to extract it but I want to utilise it from the saved database

Code

Function EmpMatch(x As String, y As String)
    Const StartRow = 2
    Dim EndRow As Long
    Dim iRow As Long
    Dim k As Integer
    Dim m As LongLong
    
        'rootpath = "\'Share\NewData\Alberts\Database"        
        'afile = Dir(rootpath & "*.csv")
     
        If InStr(1, y, "|") > 0 Or InStr(1, y, "/") > 0 Then
            k = InStr(1, y, "|") Or InStr(1, y, "/")
            'y = Left(y, InStr(1, y, "|") Or InStr(1, y, "/") - 1)
            m = Left(y, k - 1)
        Else
        m = y
        End If

        'Z = InStr(1, Mystring, "|")
        'K = Left(x, NWword - 1)
        
     
    'With Worksheets("Database")
    With afile.Sheets("EmpDataBase")
        'EndRow = .Range("A:G").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        EndRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
        For iRow = StartRow To EndRow
            If Trim(.Range("B" & iRow).Value) = Trim(x) And .Range("F" & iRow).Value = m Then
            'If .Range("B" & iRow).Value = x And .Range("F" & iRow).Value = y Then
                EmpMatch= .Range("A" & iRow).Value
                Exit Function
            End If
        Next iRow
    End With
    EmpMatch= "Notfound"
End Function

Display More

Please assist.

Rmrekoj · Sep 9th 2022

Any chance to solve this?

Rmrekoj · Sep 9th 2022

Code

Function ClientMatch(x As String, y As String)
    Const StartRow = 2
    Dim EndRow As Long
    Dim iRow As Long
    Dim k As Integer
    Dim m As LongLong
    Dim WB As Workbook
    Dim WS As Worksheet
       
     
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Set cn = New ADODB.Connection
    
    cn.ConnectionString = _
        "Provider = Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=" & ThisWorkbook.Path & "\OUPUT\;" & _
        "Extended Properties=""text;HDR=YES;"""
        '"Extended Properties=""text;HDR=YES;FMT=Delimited;Imex=1;ImportMixedTypes=Text;"""
     
    Set rs = New ADODB.Recordset
    rs.ActiveConnection = cn
    rs.Source = "SELECT * FROM [CLIENT_DATA_OUT.CSV]"

        If InStr(1, y, "|") > 0 Or InStr(1, y, "/") > 0 Then
            k = InStr(1, y, "|") Or InStr(1, y, "/")
            m = Left(y, k - 1)
        Else
        m = y
        End If

     Set rs = newADODB.Recordset
     
    With rs ''Getting error here now
        EndRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
        For iRow = StartRow To EndRow
            If Trim(.Range("B" & iRow).Value) = Trim(x) And .Range("F" & iRow).Value = m Then
                ClientMatch = .Range("A" & iRow).Value
                Exit Function
            End If
        Next iRow
    End With
    ClientMatch = "Notfound"
End Function

Display More

Rmrekoj · Sep 10th 2022

Team , need your help to fix the error @ with rs

**KjBox** · Sep 14th 2022

You cannot use SQL on a CSV file.

You need to open the CSV file in Excel then use your code or formula to extract the desired data.

**rory** · Sep 14th 2022

You can use SQL on a text file. I don't understand why the OP opens a recordset, populates it, then replaces it with a new blank recordset, and finally tries to use a recordset as a worksheet.

Rmrekoj · Sep 14th 2022

Mr. Rory,

Thanks for your response.

I had created a database sheet in the same file as "database" which is being used to run the function, and it was working fine, but instead of copying and pasting the data again and again, there is a real database saved on the server that is regularly updated, so I wanted to use that server data directly in the function so that each time will have the updated records.

Here is the current backup code that I use to acquire the most recent and fresh data.

Instead, I expected to have a direct access to the server's CSV file for the function.

Code

Sub GetDataFromSource()

    Dim cn As ADODB.Connection
    
    Set cn = New ADODB.Connection

    Dim rs As ADODB.Recordset
    
    cn.ConnectionString = _
        "Provider = Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=T:\OUPUT\;" & _
        "Extended Properties=""text;HDR=YES;"""
    
    cn.Open
    
    Set rs = New ADODB.Recordset
    rs.ActiveConnection = cn
    rs.Source = "SELECT * FROM [MainDatabase.CSV]"
    rs.Open
    Sheet2.Rows("2:" & Rows.Count).ClearContents
    Sheet2.Range("A2").CopyFromRecordset rs
    
    rs.Close
    cn.Close
Application.CalculateFullRebuild

End Sub

Display More

Thank you very much.

**rory** · Sep 14th 2022

There doesn't seem to be a question in there anywhere. What exactly is your problem currently?

Rmrekoj · Sep 14th 2022

Dear Rory,

Sorry about that - could not well describe it

In the next line, I intend to link the data of the recordset so that when I run the function or utilise it, it will execute with the most recent version straight from the server database.

Set rs = newADODB.Recordset
With rs ''Getting error here now

Instead of utilising the sub "GetDataFromSource," I'd want to link it in the preceding line.

#attached the file for your ref

Code

Function ClientMatch(x As String, y As String)
Const StartRow = 2
Dim EndRow As Long
Dim iRow As Long
Dim k As Integer
Dim m As LongLong
Dim WB As Workbook
Dim WS As Worksheet
Application.ScreenUpdating = False

If InStr(1, y, "|") > 0 Or InStr(1, y, "/") > 0 Then
k = InStr(1, y, "|") Or InStr(1, y, "/")
m = Left(y, k - 1)
Else
m = y
End If

With Worksheets("Database")
EndRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
For iRow = StartRow To EndRow
If Trim(.Range("B" & iRow).Value) = Trim(x) And .Range("F" & iRow).Value = m Then
ClientMatch = .Range("A" & iRow).Value
Exit Function
End If
Next iRow
End With
ClientMatch = "Notfound"
End Function

Display More

Code

Sub GetDataFromSource()

    Dim cn As ADODB.Connection
    
    Set cn = New ADODB.Connection

    Dim rs As ADODB.Recordset
    
    cn.ConnectionString = _
        "Provider = Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=T:\OUPUT\;" & _
        "Extended Properties=""text;HDR=YES;"""
        
    cn.Open
    
    Set rs = New ADODB.Recordset
    rs.ActiveConnection = cn
    rs.Source = "SELECT * FROM [DataBase.CSV]"
    rs.Open
    Sheet2.Rows("2:" & Rows.Count).ClearContents
    Sheet2.Range("A2").CopyFromRecordset rs
    
    
    rs.Close
    cn.Close
Application.CalculateFullRebuild

End Sub

Display More

**rory** · Sep 14th 2022

Sorry, but I am not following. Your code (from post 3 which is the only place you have those lines) makes no sense to me since you populate the recordset with data from the CSV and then immediately destroy and recreate the recordset with a second Set rs = New ADODB.Recordset line. Why do you do that?

Rmrekoj · Sep 14th 2022

Oh, I get your viewpoint here; since it has already been made, there is no need for a new one, right?

Could you kindly connect that sub () here to the function? and complete it please??

With rs

Thanks very much

**rory** · Sep 15th 2022

I still have no idea what you mean. Your function already creates and populates the recordset. What does the sub have to do with anything?

Rmrekoj · Sep 15th 2022

SUB () has been created to get the data from sharedrive to a local excel file - and then the function executes the most recent/updated value

I have to run SUB() each time for most recent/updated data-

so I want that sub() should connect in that function ( with RS) so that it will directly link to sharedriver rather than local data

**rory** · Sep 15th 2022

Your function doesn't need that sub. As I said earlier, you have already extracted the data from the server into a recordset. It's not clear what you're trying to do with the returned data, but I suspect you should be adding a WHERE clause to your SQL to restrict the data returned based on the function parameters.

Rmrekoj · Sep 17th 2022

Finally resolved- this is all I wanted.
Thanks for your support

I need some last advice on how to get the red font. If there are no matching records, "Not Found" should appear in red font.

ClientMatch = "Not Found"

ClientMatch.Interior.Color = vbRed

Ingo_Ingo · Sep 17th 2022

Try:

ClientMatch.Font.ColorIndex = 3

or

ClientMatch.Font.Color = vbRed

Rmrekoj · Sep 18th 2022

Thank you for your response,,,

However, it does not function.

getting below remark
#VALUE!

**rory** · Sep 18th 2022

You cannot set the font colour from a UDF used in a cell.

Rmrekoj · Sep 18th 2022

Oh thanks 👍

**KjBox** · Sep 18th 2022

Use conditional formatting

Extract data from a database file

Rmrekoj Sep 18th 2022

Participate now!

Share

Similar Threads

Getting Data from a pdf file in Power Query

Extract data from specific strings column

Help Extracting Data From String

extracting data from strings

Extracting Data from Text File - Identify starting point then skip down x number of lines to get to first line to extract

VBA code to extract external file links

Tags