lookupCSVResults formula

Rodrigues · Jul 12, 2015

All
I'm using lookupCSVResults, to retrieve values from cells.
I have two files, one called ProductsPO.xlsx and other Issued Stock Report.csv (have to rename to .xlsx in order to be able to upload it).
The aim is on first file where the formula is looks for the product and then retrieves the PO's number from the second file(.csv) with separate coma.
Thanks in advance.
Rodrigues

p45cal · Jul 13, 2015

Is lookupCSVResults a user-defined function?
If so then any formula with lookupCSVResults must have the user-defined function available as a macro/function. Both your files are .xlsx which means they can't have any user-defined function in!

Or have I got it all wrong?

Nebu · Jul 14, 2015

Hi:

Here is the code which will do what you are looking for

Code:

Sub GetData()
    Application.ScreenUpdating = False
    Dim fso As FileSystemObject
    Dim pth As String
    Dim fl As File
    Dim wb As Workbook
   
    Set fso = New FileSystemObject
    pth = "Yourfilepathhere"
    For Each fl In fso.GetFolder(pth).Files
      If StrComp(fso.GetExtensionName(fl.Path), "csv", vbTextCompare) = 0 Then
            Set wb = Workbooks.Open(fl.Path)
            wb.SaveAs pth & "\" & fso.GetBaseName(fl.Path), xlOpenXMLWorkbook
            wb.Close
        End If
    Next
    Set fl = Nothing
    Set fso = Nothing
   
    Dim cnStr, query, fileName As String
    Dim rs As ADODB.Recordset
    Dim Str As Long
 
    fileName = "Yourfilepathhere\Issued_Stock_Report.xlsx"
   
    cnStr = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
              "Data Source=" & fileName & ";" & _
              "Extended Properties=Excel 12.0"
 
        Str = Sheet1.Range("A2").Value
        query = "SELECT Distinct [Purchase] FROM [Issued_Stock_Report$] WHERE [Product]= " & Str
        Set rs = New ADODB.Recordset
        rs.Open query, cnStr, adOpenUnspecified, adLockUnspecified
        If Not rs.EOF Then
            ActiveSheet.Range("E2").CopyFromRecordset rs
        Else
        MsgBox "No records returned.", vbCritical
        End If
    rs.Close
    Set cnStr = Nothing
    Set rs = Nothing
    Kill fileName
    Dim i, j As Long
    Dim s As String
    i = Sheet1.Cells(Rows.Count, "E").End(xlUp).Row
    For j = 2 To i
    s = s & Sheet1.Cells(j, 5)
    Next
    Sheet1.Range("E2") = "'" & s
    AddCommas
    Sheet1.Range("E3:E" & i).ClearContents
    Application.ScreenUpdating = False
End Sub

Sub AddCommas()
    Dim s As String
    s = Sheet1.Range("E2")
    Dim x As Long
    x = Len(s) \ 3
    If Len(s) Mod 3 = 0 Then
        x = x - 1
    End If
    Do Until x <= 0
        s = Left(s, x * 3) & "," & Mid(s, x * 3 + 1)
        x = x - 1
    Loop
    Sheet1.Range("E2") = s
End Sub

You will have to add the following references in your VBA Editor

Microsoft ActiveX Data Objects 6.1 Library
Microsoft Scripting Runtime

The code will convert your csv file into xlsx and use ADODB connection to pull the relevant data. After getting the data in the desired format it will kill the xlsx file . All this will happen in the background. Try to save your csv file and the macro file in the same folder. I am attaching the workbook with the coding here knock yourself out and let me know with questions if any.

Note: Remember to change the path in the code where I have give yourfilepath here to your respective file path.

Thanks

NARAYANK991 · Jul 14, 2015

Hi ,

Try this :

Code:

Sub GetData()
    Dim ce As Range
    Dim delimiter As String
    Dim cn As Object
    Dim rs As Object
    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
   
    delimiter = ","
    pth = ThisWorkbook.Path & "\"
   
    cnStr = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
            "Data Source=" & pth & ";" & _
            "Extended Properties = ""text; HDR=Yes"""
    cn.Open cnStr
   
    Application.ScreenUpdating = False
   
    For Each ce In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
        CSV_Output = vbNullString
        param1 = ce.Value
        queryStr = "SELECT Distinct [Purchase] FROM Issued_Stock_Report.csv WHERE [Product]= " & param1
        rs.Open queryStr, cn, 3, 4
        Do While Not rs.EOF
          CSV_Output = CSV_Output & delimiter & rs.Fields("Purchase")
          rs.MoveNext
        Loop
        rs.Close
        With Cells(ce.Row, 4)
            .NumberFormat = "@"
            .Value = Mid(CSV_Output, 2)
        End With
    Next ce
   
    Set rs = Nothing
    Set cn = Nothing
   
    Application.ScreenUpdating = True
End Sub

Note that your .csv file needs to remain unopened , and as a text file.

Narayan

Rodrigues · Jul 14, 2015

Nebu said:

Hi:

Here is the code which will do what you are looking for

Code:

Sub GetData()
    Application.ScreenUpdating = False
    Dim fso As FileSystemObject
    Dim pth As String
    Dim fl As File
    Dim wb As Workbook
 
    Set fso = New FileSystemObject
    pth = "Yourfilepathhere"
    For Each fl In fso.GetFolder(pth).Files
      If StrComp(fso.GetExtensionName(fl.Path), "csv", vbTextCompare) = 0 Then
            Set wb = Workbooks.Open(fl.Path)
            wb.SaveAs pth & "\" & fso.GetBaseName(fl.Path), xlOpenXMLWorkbook
            wb.Close
        End If
    Next
    Set fl = Nothing
    Set fso = Nothing
 
    Dim cnStr, query, fileName As String
    Dim rs As ADODB.Recordset
    Dim Str As Long

    fileName = "Yourfilepathhere\Issued_Stock_Report.xlsx"
 
    cnStr = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
              "Data Source=" & fileName & ";" & _
              "Extended Properties=Excel 12.0"

        Str = Sheet1.Range("A2").Value
        query = "SELECT Distinct [Purchase] FROM [Issued_Stock_Report$] WHERE [Product]= " & Str
        Set rs = New ADODB.Recordset
        rs.Open query, cnStr, adOpenUnspecified, adLockUnspecified
        If Not rs.EOF Then
            ActiveSheet.Range("E2").CopyFromRecordset rs
        Else
        MsgBox "No records returned.", vbCritical
        End If
    rs.Close
    Set cnStr = Nothing
    Set rs = Nothing
    Kill fileName
    Dim i, j As Long
    Dim s As String
    i = Sheet1.Cells(Rows.Count, "E").End(xlUp).Row
    For j = 2 To i
    s = s & Sheet1.Cells(j, 5)
    Next
    Sheet1.Range("E2") = "'" & s
    AddCommas
    Sheet1.Range("E3:E" & i).ClearContents
    Application.ScreenUpdating = False
End Sub

Sub AddCommas()
    Dim s As String
    s = Sheet1.Range("E2")
    Dim x As Long
    x = Len(s) \ 3
    If Len(s) Mod 3 = 0 Then
        x = x - 1
    End If
    Do Until x <= 0
        s = Left(s, x * 3) & "," & Mid(s, x * 3 + 1)
        x = x - 1
    Loop
    Sheet1.Range("E2") = s
End Sub

You will have to add the following references in your VBA Editor

Microsoft ActiveX Data Objects 6.1 Library
Microsoft Scripting Runtime

The code will convert your csv file into xlsx and use ADODB connection to pull the relevant data. After getting the data in the desired format it will kill the xlsx file . All this will happen in the background. Try to save your csv file and the macro file in the same folder. I am attaching the workbook with the coding here knock yourself out and let me know with questions if any.

Note: Remember to change the path in the code where I have give yourfilepath here to your respective file path.

Thanks

Hi Nebu
Thank you very much for your reply, does work.
I have a few queries/amendments to ask if you don't mind.
a) I need the result in block of six (6) figures;
b) Sheet 1 range needs to be the entire column A;
c) Therefore the results needs to be displayed entire column E, separated by comma;
Thanks.

Rodrigues · Jul 14, 2015

NARAYANK991 said:

Hi ,

Try this :

Code:

Sub GetData()
    Dim ce As Range
    Dim delimiter As String
    Dim cn As Object
    Dim rs As Object
    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
  
    delimiter = ","
    pth = ThisWorkbook.Path & "\"
  
    cnStr = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
            "Data Source=" & pth & ";" & _
            "Extended Properties = ""text; HDR=Yes"""
    cn.Open cnStr
  
    Application.ScreenUpdating = False
  
    For Each ce In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
        CSV_Output = vbNullString
        param1 = ce.Value
        queryStr = "SELECT Distinct [Purchase] FROM Issued_Stock_Report.csv WHERE [Product]= " & param1
        rs.Open queryStr, cn, 3, 4
        Do While Not rs.EOF
          CSV_Output = CSV_Output & delimiter & rs.Fields("Purchase")
          rs.MoveNext
        Loop
        rs.Close
        With Cells(ce.Row, 4)
            .NumberFormat = "@"
            .Value = Mid(CSV_Output, 2)
        End With
    Next ce
  
    Set rs = Nothing
    Set cn = Nothing
  
    Application.ScreenUpdating = True
End Sub

Note that your .csv file needs to remain unopened , and as a text file.

Narayan

Hi Narayan
Thank you s much for your reply.
I'm getting the following error:
Compile error. Variable not defined
Also I need entire columns A and E as a range.
Please your thoughts.

Highlights in blue pth where is pth = ThisWorkbook.Path & "\"

Nebu · Jul 15, 2015

Hi:

I need the result in block of six (6) figures;

Do you mean to say that you want commas after every six digits?

Sheet 1 range needs to be the entire column A

Does this mean you will be having a range of values in column A which you have to look up and want to loop through it?

Therefore the results needs to be displayed entire column E, separated by comma;

I assume you want respective results to be displayed for each value in column A in Column E.

All the above is possible, could you please confirm whether the above mentioned is what you are looking for. For more clarity you can upload a workbook with desired output I can make the corresponding changes in the code.

Thanks

NARAYANK991 · Jul 15, 2015

Hi Rodrigues ,

Try this :

Code:

Sub GetData()
    Dim ce As Range
    Dim delimiter As String, pth As String, cnStr As String, CSV_Output As String, queryStr As String
    Dim param1 As Variant
    Dim cn As Object
    Dim rs As Object
    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
   
    delimiter = ","
    pth = ThisWorkbook.Path & "\"
   
    cnStr = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
            "Data Source=" & pth & ";" & _
            "Extended Properties = ""text; HDR=Yes"""
    cn.Open cnStr
   
    Application.ScreenUpdating = False
   
    For Each ce In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
        CSV_Output = vbNullString
        param1 = ce.Value
        queryStr = "SELECT Distinct [Purchase] FROM Issued_Stock_Report.csv WHERE [Product]= " & param1
        rs.Open queryStr, cn, 3, 4
        Do While Not rs.EOF
          CSV_Output = CSV_Output & delimiter & rs.Fields("Purchase")
          rs.MoveNext
        Loop
        rs.Close
        With Cells(ce.Row, 5)
            .NumberFormat = "@"
            .Value = Mid(CSV_Output, 2)
        End With
    Next ce
   
    Set rs = Nothing
    Set cn = Nothing
   
    Application.ScreenUpdating = True
End Sub

Please note that it is assumed your data starts from cell A2 and extends downwards ; this entire range is already being taken care of. For example , if your data extends to A100 , all the values from A2 through A100 will be checked , and the outputs will be populated in the cells E2 through E100.

Narayan

Rodrigues · Jul 20, 2015

Hi Narayan
Does work, but I have a new challenge which is that: at the beginning this supposed to be a file to be done as and when required, now it will work as a small database.
I'm wondering if is possible to do that:
1 - the vba & formula look at the "Complaints data.xlsx" data file for entire "Columns A and D and E" look for date & Line number & Product, than on "Issued Stock Report.csv" extract the correct information and populate it on "Complaints data.xlsx" cell F respectively. If needed to help, each "Issued Stock Report.csv" it can be saved with date of complain search, something like: Issued Stock Report 01042015.csv (have to save as .xlsx to be able to upload.
Have attached both example files.
Many thanks again in advance.
Regards
Rodrigues

lookupCSVResults formula

Rodrigues

Member

Attachments

p45cal

Well-Known Member

Nebu

Excel Ninja

Attachments

NARAYANK991

Excel Ninja

Rodrigues

Member

Rodrigues

Member

Nebu

Excel Ninja

NARAYANK991

Excel Ninja

Rodrigues

Member

Attachments