Tweaking a Excel Pivot Table to display a OrderNumber instead of a calculation? - excel-2007

Using Microsoft Excel 2007 (or 2002) is it possible to create pivot data like this?
Specifically I would like to know if I can display '01(Y 0)' as a non-calculated text value instead of just a SUM/COUNT/MAX/etc value.

With ADO
Dim cn As Object
Dim rs As Object
Dim strFile As String
Dim strCon As String
Dim strSQL As String
Dim s As String
Dim i As Integer, j As Integer
''This is not the best way to refer to the workbook
''you want, but it is very convenient for notes
''It is probably best to use the name of the workbook.
strFile = ActiveWorkbook.FullName
''Note that if HDR=No, F1,F2 etc are used for column names,
''if HDR=Yes, the names in the first row of the range
''can be used.
''This is the Jet 4 connection string, you can get more
''here : http://www.connectionstrings.com/excel
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _
& ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
''Late binding, so no reference is needed
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Open strCon
strSQL = "TRANSFORM First(t.[Order Number]) AS OrdNo " _
& "SELECT t.[Slot Number], t.Time " _
& "FROM [Sheet2$] t " _
& "GROUP BY t.[Slot Number], t.Time " _
& "PIVOT t.Company"
rs.Open strSQL, cn, 3, 3
''Pick a suitable empty worksheet for the results
With Worksheets("Sheet3")
For i = 1 To rs.Fields.Count
.Cells(1, i) = rs.Fields(i - 1).Name
Next
.Cells(2, 1).CopyFromRecordset rs
End With
''Tidy up
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing

Related

Missing data partially importing filtered text file data through sql with excel vba

I would like to import a 30Mb text file into excel filtering just what I want.
I have tried with small files and I see that some columns with byte data shows problems. I see a black sell or wrong values.
I tried different provider for the connection but I loose always data.
text_2.txt:
946737293;98FECB80;FF;FF;0;0;0;0;FF;FF
946737293;98EAFFFE;0;EE;0;0;0;0;FF;FF
946737294;98FE0F82;65;6E;4F;0;0;0;FF;FF
946737295;8CFD0282;FF;FF;FF;FF;FF;FF;0;FD
946737295;9CE78280;FF;1;5;FF;FF;FF;FF;FF
946737295;9CE78280;C0;FF;0;0;0;0;FF;FF
946737296;8CFD0282;FF;FF;FF;FF;FF;FF;0;FD
excel result
Sub FilterFile2()
Dim log_path As String
Dim log_file As String
Dim objConnection As ADODB.Connection 'Object
Dim objRecSet As ADODB.Recordset 'Object
Dim strConnection As String
Dim strSql As String
Dim strPath As String
Dim strTable As String
Dim ws As Variant
strPath = "I:\Codici\Excel\filtra_file_testo"
strTable = "test_2.txt"
strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & strPath & ";Extended Properties='Text;HDR=NO;IMEX=1'"
' SAME PROBLEM
'strConnection = "Driver={Microsoft Text Driver (*.txt; *.csv)};" & _
' "Dbq=" & strPath & ";Extensions=asc,csv,tab,txt;" 'HDR=NO;Persist Security Info=False"
'https://www.exceltip.com/import-and-export-in-vba/import-data-from-a-text-file-ado-using-vba-in-microsoft-excel.html
' SAME PROBLEM
'strConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
'"Data Source=" & strPath & ";Extended Properties='Text;HDR=NO;IMEX=1'"
'ADOX doesn't read the data, you still use ADODB for that.
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open strConnection
strSql = "SELECT * " & _
" FROM " & strTable & _
" WHERE F3='FF'"
'" WHERE F2='9CE78280'" 'the same problem
Debug.Print strSql
Set objRecSet = New ADODB.Recordset
objRecSet.Open strSql, objConnection, adOpenForwardOnly, adLockReadOnly, adCmdText
'Set objRecSet = objConnection.Execute(strSql)
If objRecSet.State <> adStateOpen Then
objConnection.Close
Set objConnection = Nothing
Exit Sub
End If
'Copy Data to Excel'
Set ws = ActiveSheet
''ActiveCell.CopyFromRecordset objRecSet
ws.Cells(12, 2).CopyFromRecordset objRecSet 'write new data 'colonna 5 e 6 non corrette
objRecSet.Close
objConnection.Close
End Sub

How to fix 'Automation Error' in vba when querying worksheets

I am trying to join three tables to show inventory by location for similar Items associated by "Key".
So to do that, I am joining my product list, DS, to SM which is my master list with associated products on KEY, which is an index of different product information. Finally I need to pull each one of those item's inventory information by location.
It is throwing an "Automation error" from VBA when it is trying to establish the recordset. This works when I dont have the second join in my SQL string (attaching INV table).
Private Sub CommandButton1_Click()
Dim strFile
Dim strCon
Dim strSQL
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim I
Dim SQL
strSQL = "SELECT s1.KEY, s1.Item, Loc, QOH, Total_Ship_To_WIP, Tot_Opn+pick_Units, Reserve " _
& "FROM ([SM$] AS s1 " _
& "RIGHT JOIN [DS$] AS s2 ON s1.[KEY] = s2.[KEY]) " _
& "LEFT JOIN [INV$] AS s3 ON s2.[Item] = s3.[Full_Style]"
strFile = ActiveWorkbook.FullName
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile _
& ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Open strCon
rs.Open strSQL, cn 'error
For I = 0 To rs.Fields.Count - 1
ActiveWorkbook.Sheets("Sheet1").Range("a10").Offset(0, I).Value = rs.Fields(I).Name
Next
ActiveWorkbook.Sheets("Sheet1").Range("a11").CopyFromRecordset rs
End Sub

excel, VBA, duplicate values

I have a large spreadsheet I was asked to edit. Basically wherever the data was pulled from, it created several duplicates of individuals names, country, start dates, and end dates. Would it be possible to get the start and stop dates in adjacent cells and remove the duplicate data?
I have provided a screen shot. Manually copying, pasting, and deleting would take a very long time since this spreadsheet has over 2300 rows with approximately 50% being duplicates that will need edited.
thanks
VBA shouldn't be necessary here, just add a new column with the formula:
=CONCATENATE(C1,D1)
Replace the column letters with your column letters for Start Date and End Date.
You can then use Excel's remove duplicates function on the new column (Data -> Remove Duplicates)
Using SQL is suitable.
Sub myQuery()
Dim strSQL As String
Dim strTable As String
Dim Ws As Worksheet
strTable = "[" & ActiveSheet.Name & "$]"
strSQL = "SELECT NAME, COUNTRY, MIN([Start Date]) as [Start Date] , max([End Date]) as [End Date] "
strSQL = strSQL & " FROM " & strTable & " "
strSQL = strSQL & " Where not isnull(NAME) "
strSQL = strSQL & " Group by NAME, COUNTRY "
Set Ws = Sheets.Add
exeSQL strSQL, Ws
End Sub
Sub exeSQL(strSQL As String, Ws As Worksheet)
Dim Rs As Object
Dim strConn As String
Dim i As Integer
strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & ThisWorkbook.FullName & ";" & _
"Extended Properties=Excel 12.0;"
Set Rs = CreateObject("ADODB.Recordset")
Rs.Open strSQL, strConn
If Not Rs.EOF Then
With Ws
.Range("a1").CurrentRegion.ClearContents
For i = 0 To Rs.Fields.Count - 1
.Cells(1, i + 1).Value = Rs.Fields(i).Name
Next
.Range("a" & 2).CopyFromRecordset Rs
.Columns.AutoFit
End With
End If
Rs.Close
Set Rs = Nothing
End Sub

VBA ADODB- Select query using the excel sheet of the same workbook as Database

I am novice in VBA so please don't mind if the question is of low level.I am trying to run a SQL query where the data has to be extracted from one of the sheets of the same workbook.
SQL = "Select ProductNumber from [sData$] where ProductSource = " & pSource & "
'pSource is a string that stores Product Source
'sdata is a sheet named as Data in the workbook
dataPath = ThisWorkbook.Fullname
'Not sure if this is the value I shall send as datapath in getData function
Set rst = getData(dataPath,SQL)
rst.Open
The getData function is defines as below
Public funtion getData(path as String, SQL as string) as ADODB.Recordset
Dim rs as ADODB.Recordset
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
cn.Open ("Provider= Microsoft.Jet.OLEDB.4.0;" & _
"DataSource= " & path & ";"&_
"Extended Properties=""Excel 8.0;HDR=Yes;FMT=Delimited;IMEX=1;""")
rs.ActiveConnection =cn
rs.Source= SQL
Set getData =rs
End Function
Now after I get the numbers from Data sheet, I need to find the corresponding
ProductCompany from Relation sheet. 9 is for Amul, 5 is for Nestle and so on.
Relation:
I am not sure how to do that. The numbers corresponds to their respective Product company in order.
Take a look at the below example showing how to create ADODB connection to this workbook, get ADODB recordset from SQL query, retrieve key - value pairs from relation sheet, create and populate a dictionary, and output the values from the recordset and the corresponding values from the dictionary:
Option Explicit
Sub Test()
Dim oCn As Object
Dim oRs As Object
Dim aKeys
Dim aItems
Dim i As Long
Dim oDict As Object
Dim dProdNum
' create ADODB connection to this workbook
Set oCn = CreateObject("ADODB.Connection")
oCn.Open _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"DataSource='" & ThisWorkbook.FullName & "';" & _
"Extended Properties=""Excel 8.0;HDR=Yes;FMT=Delimited;IMEX=1;"";"
' get ADODB recordset from SQL query
Set oRs = oCn.Execute("SELECT DISTINCT ProductNumber FROM [Data$] WHERE ProductSource = 'A1'")
' retrieve key - value pairs from relation sheet
With ThisWorkbook.Sheets("Relation")
aKeys = Split(.Range("B1"), ",")
aItems = Split(.Range("B2"), ",")
End With
' create and populate a dictionary
Set oDict = CreateObject("Scripting.Dictionary")
For i = 0 To UBound(aKeys)
oDict(Trim(aKeys(i)) + 0) = Trim(aItems(i))
Next
' output the values from the recordset and the corresponding values from the dictionary
oRs.MoveFirst
Do Until oRs.EOF
dProdNum = oRs.Fields(0).Value
Debug.Print dProdNum & " - " & oDict(dProdNum)
oRs.MoveNext
Loop
End Sub
The output for me is as follows:
4 - Britanica5 - Nestle9 - Amul
Note, connection string in the above code shown for .xls file. In case .xlsm you should use:
oCn.Open _
"Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source='" & ThisWorkbook.FullName & "';" & _
"Extended Properties=""Excel 12.0 Macro;HDR=Yes;FMT=Delimited;IMEX=1;"";"

SQL ADODB Recordset select distinct is in alphabetical order

I'm using an ADODB record set in VBA. When I use Select Distinct in a SQL query of the ADODB record set the results come out in alphabetical order. I need the results in the order they are in the data. Is that possible?
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
DatPath = ThisWorkbook.Path & "\Temp\" & TB.Name
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DatPath & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
cn.Open strCon
strSQL = "SELECT Distinct(Period) from [Data$] "
rs.Open strSQL, cn, 3, 3
ThisWorkbook.Sheets("ADO Out").Cells.Clear
ThisWorkbook.Sheets("ADO Out").Activate
ThisWorkbook.Sheets("ADO Out").Cells(1, 1).CopyFromRecordset rs
Here are two workarounds that both involve retrieving all Period records.
Range.RemoveDuplicates will remove the duplicates while preserving the order
Sub UnorderedPeriod()
Dim DatPath As String, strCon As String, strSQL As String
Dim cn As Object, rs As Object
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
DatPath = ThisWorkbook.Path & "\Temp\" & TB.Name
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DatPath & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
cn.Open strCon
strSQL = "SELECT [Period] from [Data$]"
rs.Open strSQL, cn, 3, 3
With ThisWorkbook.Sheets("ADO Out")
.Cells.Clear
.Cells(1, 1).CopyFromRecordset rs
.Activate
.Columns(1).RemoveDuplicates Columns:=1
End With
End Sub
Use an ArrayList to remove the duplicates
Function CopyDistinctFromRecordset(rs As Object, Target As Range)
Dim list As Object
Dim data
Dim x As Long
rs.MoveFirst
data = rs.getRows
Set list = CreateObject("System.Collections.ArrayList")
For x = 0 To UBound(data, 2)
If Not list.Contains(data(0, x)) Then list.Add data(0, x)
Next
Target.Resize(list.Count).Value = Application.Transpose(list.ToArray)
End Function