[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 466
  • Last Modified:

Transpose data by date then add the count, average, and standard deviation in Access VBA

I have data that is being collected in an Access 2003 .mdb by date.  There are as few as one to many records on any given day.  I need to transpose the row data so that the date is in the first column, then a number of columns is generated to include the value for that given day.  In the sample data, for example, I am including Impact score which ranges from 0 to 100 in 20 point increments.  At the end of the last column, I want to add a "count" or total for that given day, an "average" for that given day, then the "standard deviation" for that day."

I am looking for some VBA to query the data and remove any dates that have missing values, then transpose the data and add the count, average, and standard deviation for that day.  I've attached the sample data that is on the same sheet, both the source and the hand transposed data just under the source.
SampleData.xls
0
atljarman
Asked:
atljarman
  • 10
  • 7
2 Solutions
 
Rey Obrero (Capricorn1)Commented:
test this db, run the sub createflatTable in module1

then open table "T"
Database7.mdb
0
 
atljarmanAuthor Commented:
Capricorn1,

Thanks again for your help.  This is great.  Do you know how to add the count, average, and std dev to the end of the columns (three extra columns)?
0
 
Rey Obrero (Capricorn1)Commented:
you need to create user define functions (a function for the count, a function for the average, and a function for the std dev)   in a regular module and use them in a query
0
Nothing ever in the clear!

This technical paper will help you implement VMware’s VM encryption as well as implement Veeam encryption which together will achieve the nothing ever in the clear goal. If a bad guy steals VMs, backups or traffic they get nothing.

 
atljarmanAuthor Commented:
Capricorn1,

Seems like you would want to put a calculation, in what you provided, between:

Loop
rs.Close

This way you could take advantage of the count being:
Count = (Impact1 + Impact2 ... + Impact(i))
Average = Average(Impact1 + Impact2 ... + Impact(i))
StandDev = Stdev(Impact1 + Impact2 ... + Impact(i))

Since it would be hard to know the total number of columns, wouldn't it be better to add it that way so that you know that number of Impact columns or Impact(i).  I'm just not sure that this would work.  Any thoughts?
0
 
Rey Obrero (Capricorn1)Commented:
the values and number of columns may always varies based on the data from excel, better to create the query using vba codes too..

run the sub createTheQuery from module1
also in the module are the functions fAverage, fCount and fStDev


Database7.mdb
0
 
atljarmanAuthor Commented:
Capricorn1,

This is great.  I tied the two modules to a form button.  I get a run time error 6 over flow error.  Do you know what might be causing this.

Also, I want to do the same thing using an excel macro and create a new sheet.  Once we close this one out, I am going to ask a new question.  Let me know if you think this is possible.
Database7.mdb
0
 
Rey Obrero (Capricorn1)Commented:
you might be having a record with only one impact field filled,

revise the function fStDev like this
Function fStDev(ParamArray sArg()) As Double
Dim j As Integer, cntFld As Integer, sumFld As Double
Dim sumAvg As Double, fAve As Double
If LBound(sArg) = UBound(sArg) Then
    fStDev = 0
    Exit Function
End If
For j = LBound(sArg) To UBound(sArg)
    If sArg(j) & "" <> "" Then
        cntFld = cntFld + 1
    End If
    sumFld = sumFld + Nz(sArg(j))
Next
fAve = sumFld / cntFld
For j = LBound(sArg) To UBound(sArg)
    If sArg(j) & "" <> "" Then
         sumAvg = sumAvg + (sArg(j) - fAve) ^ 2
    End If
Next
fStDev = Sqr(sumAvg / (cntFld - 1))

End Function

Open in new window

0
 
atljarmanAuthor Commented:
Your right.  I am trying to figure out how to make the stdev null if the cntfld = 1.  I'm not succeeding.
Function fStDev(ParamArray sArg()) As Double
Dim j As Integer, cntFld As Integer, sumFld As Double
Dim sumAvg As Double, fAve As Double
If LBound(sArg) = UBound(sArg) Then
    fStDev = 0
    Exit Function
End If
For j = LBound(sArg) To UBound(sArg)
    If sArg(j) & "" <> "" Then
        cntFld = cntFld + 1
    End If
    sumFld = sumFld + Nz(sArg(j))
Next
fAve = sumFld / cntFld
For j = LBound(sArg) To UBound(sArg)
    If sArg(j) & "" <> "" Then
         sumAvg = sumAvg + (sArg(j) - fAve) ^ 2
    End If
Next

MsgBox cntFld
If cntFld = 1 Then
fStDev = Null
Else
fStDev = Sqr(sumAvg / (cntFld - 1))
End If

End Function

Open in new window

0
 
Rey Obrero (Capricorn1)Commented:
use this function, copy and paste


Function fStDev(ParamArray sArg()) As Variant
Dim j As Integer, cntFld As Integer, sumFld As Double
Dim sumAvg As Double, fAve As Double
If LBound(sArg) = UBound(sArg) Then
    fStDev = Null
    Exit Function
End If
For j = LBound(sArg) To UBound(sArg)
    If sArg(j) & "" <> "" Then
        cntFld = cntFld + 1
    End If
    sumFld = sumFld + Nz(sArg(j))
Next
fAve = sumFld / cntFld
For j = LBound(sArg) To UBound(sArg)
    If sArg(j) & "" <> "" Then
         sumAvg = sumAvg + (sArg(j) - fAve) ^ 2
    End If
Next
fStDev = CDbl(Sqr(sumAvg / (cntFld - 1)))

End Function

Open in new window

0
 
Rey Obrero (Capricorn1)Commented:

scrap that codes, use this one
Function fStDev(ParamArray sArg()) As Variant
Dim j As Integer, cntFld As Integer, sumFld As Double
Dim sumAvg As Double, fAve As Double
For j = LBound(sArg) To UBound(sArg)
    If sArg(j) & "" <> "" Then
        cntFld = cntFld + 1
    End If
    sumFld = sumFld + Nz(sArg(j))
Next
If cntFld = 1 Then
    fStDev = Null
    Exit Function
End If
fAve = sumFld / cntFld
For j = LBound(sArg) To UBound(sArg)
    If sArg(j) & "" <> "" Then
         sumAvg = sumAvg + (sArg(j) - fAve) ^ 2
    End If
Next
fStDev = CDbl(Sqr(sumAvg / (cntFld - 1)))

End Function

Open in new window

0
 
atljarmanAuthor Commented:
That worked.  What if you had more than one column and wanted to do the same thing for the other variables.  Could you stack the spreadsheet with the variable name in the far left column, then the date, then the values 1-17?
Database7.mdb
0
 
atljarmanAuthor Commented:
I forgot to mention tblImpact2 has more than one column for testing.
0
 
Rey Obrero (Capricorn1)Commented:
i believe your original question on this thread which is actually more than one has already been resolved.

kindly close this thread and open another question for your other problems...
0
 
atljarmanAuthor Commented:
Your right.  After I posted, I realized my error in continuing to request.  Great Job on completing the question as stated.
0
 
atljarmanAuthor Commented:
Great Job Capricorn1
0
 
atljarmanAuthor Commented:
Capricorn1,

I've awarded points.  I went and tried to wrap the code you provided in a function that I could call with the arguments "MyTable" and "MyVariable"   MyVariable of course, is the variable in the table.  The only challenge is that the rs!Impact in the attached code... I can't change it to rs!MyVariable.  I get the item is not found in this collection (Run time Error 3265).

Do you know what I can change this to?
Sub createFlatTable(myTable As String, myVariable As String)
Dim rs As DAO.Recordset, j As Integer, i, sImpact As String, sFld
Dim rsMax As DAO.Recordset, rsNew As DAO.Recordset, maxImp
Dim rs1 As DAO.Recordset
Set rsMax = CurrentDb.OpenRecordset("select top 1 count([Date]) from " & myTable & _
            " Where " & myVariable & " <>null group by [Date] order by count([Date]) desc")
maxImp = rsMax(0)
For i = 1 To maxImp
    'sImpact = sImpact & "," & "Impact" & i & " Integer"
    sImpact = sImpact & "," & myVariable & i & " Integer"
Next
sImpact = "[Date] DateTime" & sImpact
If DCount("*", "msysobjects", "[name]='T'") > 0 Then
    CurrentDb.Execute "drop table T"
End If
CurrentDb.Execute "create table T(" & sImpact & ")"

Dim test As String
test = myVariable

Set rs = CurrentDb.OpenRecordset("select distinct [Date] from " & myTable)
Set rsNew = CurrentDb.OpenRecordset("T")
rs.MoveFirst
Do Until rs.EOF
    Set rs1 = CurrentDb.OpenRecordset("select * from  " & myTable & " where [Date]=#" & rs![Date] & "# and " & myVariable & " <>null ")
    If Not rs1.EOF Then
        rsNew.AddNew
        rsNew![Date] = rs1![Date]
        j = 1
        Do Until rs1.EOF
            If rs1!MyVariable & "" <> "" Then
            'If rs1![MyVariable] & "" <> "" Then
            'rsNew("Impact" & j) = rs1!Impact
            rsNew(myVariable & j) = rs1!MyVariable
            'rsNew(myVariable & j) = rs1![MyVariable]
            j = j + 1
            End If
            rs1.MoveNext
        Loop
        rsNew.Update
    End If
rs.MoveNext
Loop
rs.Close
rs1.Close
rsNew.Close
rsMax.Close

End Sub

Open in new window

0
 
atljarmanAuthor Commented:
This is what I used, and it worked for proper referencing.  Thanks again for your patience Capricorn1.
Sub createFlatTable(myTable As String, myVariable As String)
Dim rs As DAO.Recordset, j As Integer, i, sImpact As String, sFld
Dim rsMax As DAO.Recordset, rsNew As DAO.Recordset, maxImp
Dim rs1 As DAO.Recordset
Set rsMax = CurrentDb.OpenRecordset("select top 1 count([Date]) from " & myTable & _
            " Where " & myVariable & " <>null group by [Date] order by count([Date]) desc")
maxImp = rsMax(0)
For i = 1 To maxImp
    'sImpact = sImpact & "," & "Impact" & i & " Integer"
    sImpact = sImpact & "," & myVariable & i & " Integer"
Next
sImpact = "[Date] DateTime" & sImpact
If DCount("*", "msysobjects", "[name]='T'") > 0 Then
    CurrentDb.Execute "drop table T"
End If
CurrentDb.Execute "create table T(" & sImpact & ")"

Dim test As String
test = myVariable

Set rs = CurrentDb.OpenRecordset("select distinct [Date] from " & myTable)
Set rsNew = CurrentDb.OpenRecordset("T")
rs.MoveFirst
Do Until rs.EOF
    Set rs1 = CurrentDb.OpenRecordset("select * from  " & myTable & " where [Date]=#" & rs![Date] & "# and " & myVariable & " <>null ")
    If Not rs1.EOF Then
        rsNew.AddNew
        rsNew![Date] = rs1![Date]
        j = 1
        Do Until rs1.EOF
            If rs1.Fields(myVariable) & "" <> "" Then
            rsNew(myVariable & j) = rs1.Fields(myVariable)
            j = j + 1
            End If
            rs1.MoveNext
        Loop
        rsNew.Update
    End If
rs.MoveNext
Loop
rs.Close
rs1.Close
rsNew.Close
rsMax.Close

End Sub

Open in new window

0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 10
  • 7
Tackle projects and never again get stuck behind a technical roadblock.
Join Now