Posts in category Uncategorized

Create Sheets based on a Column

Nov10
2008 Leave a Comment Written by admin

Ever felt the need of creating different sheets based on the distinct values of a column. For example, in your data, you have a column called STATE, and you would like to create a separate sheet for each state with all the data from that state. Here’s your solution then:
(Note: you’ll need to add a UDF function UniqueItems from http://j-walk.com/ss/excel/tips/tip15.htm)

This procedure will create a new sheet for each unique item in the selected column with the data from the main sheet for that unique item. As an added bonus, the procedure will sort the sheets ascending (Courtesy:ozgrid.com)
‘—————————————————————————————
‘ Procedure : CreateSheetsColumn
‘ DateTime  : 11/10/2008 09:32
‘ Author    : ARN
‘ Purpose   : To create sheets with the data from the main sheet based on a selected column.
‘Assumptions:
    ’1 -  data are in contigious form
    ’2 – the unique column does not have any special characters
    ’3 – the first row is the header row
    ’4 – the only sheet in the workbook is the data workbook
‘—————————————————————————————
‘
Public Sub CreateSheetsColumn()

On Error GoTo CreateSheetsColumn_Error
    Dim rngInput As Range, rngColAddr As Range, varrUniqueVals() As Variant, dCounter As Double
    Dim rngCol As Range
    Dim dUniqueItems As Double, dColtoFilterOn As Double
    
    Dim lCount As Long, lShtLast As Long, lCount2 As Long
    
    ‘Set the working range
    Set rngInput = ActiveSheet.Range(Cells(1, 1), Cells(1, 1).SpecialCells(xlLastCell))
                                    
    ‘get the column to work on from the user
    Set rngColAddr = Application.InputBox(prompt:=”Select the column that would be used to create distinct sheets”, _
                                    Title:=”Select a Column”, _
                                    Type:=8)
    ‘if more than one column is selected, exit
    If rngColAddr.Columns.Count > 1 Then
        MsgBox “Too many columns; select only one column”, vbOKOnly
        Exit Sub
    End If
    
    ‘set the application screen updating to false to increase execution speed
    Application.ScreenUpdating = False
    
    ‘store the column number in a variable
    dColtoFilterOn = rngColAddr.Column
    
    ‘set a range from the 2nd row to the last row from the selected column to get the distinct values
    Set rngCol = ActiveSheet.Range(Cells(2, dColtoFilterOn), Cells(rngInput.Rows.Count, dColtoFilterOn))
    
    ‘use the function UniqueItems (http://j-walk.com/ss/excel/tips/tip15.htm) to get unique values from the selected column
    varrUniqueVals = UniqueItems(rngCol, False)
    
    ‘get the total number of unique items
    dUniqueItems = UBound(varrUniqueVals, 1)
    
    ‘start a loop to filter the range on each unique item
    For dCounter = 1 To dUniqueItems
        ‘ only if the unique value is not blank
        If Not varrUniqueVals(dCounter) = “” Then
            ‘ apply filter
            rngInput.AutoFilter Field:=dColtoFilterOn, Criteria1:=varrUniqueVals(dCounter)
            
            ‘add a new sheet
            Sheets.Add After:=Sheets(Sheets.Count)
            
            ‘rename the sheet
            ActiveSheet.Name = varrUniqueVals(dCounter)
            
             >‘copy the filtered data
            rngInput.Copy Destination:=Worksheets(varrUniqueVals(dCounter)).Range(“A1″)
            
            ‘remove copy
            Application.CutCopyMode = False
        End If
    Next dCounter
    
    ‘remove filter
    rngInput.AutoFilter
    
    
    ‘ Sort sheets ascending – except the first one
    ‘ copied from http://www.ozgrid.com/VBA/sort-sheets.htm
    
    lShtLast = Sheets.Count
    For lCount = 2 To lShtLast
            For lCount2 = lCount To lShtLast
                If UCase(Sheets(lCount2).Name) < UCase(Sheets(lCount).Name) Then
                    Sheets(lCount2).Move Before:=Sheets(lCount)
                End If
            Next lCount2
        Next lCount
        
MsgBox “Done”

On Error GoTo 0
SmoothExit_CreateSheetsColumn:

    Application.ScreenUpdating = True

    Exit Sub

CreateSheetsColumn_Error:
    MsgBox “Error ” & Err.Number & ” (” & Err.Description & “) in Sub:CreateSheetsColumn”
    Resume SmoothExit_CreateSheetsColumn
End Sub

Tagged , , ,

Student’s t-test for equal means

Oct29
2008 Leave a Comment Written by admin

If you do not wish to enter complex formula in Excel and you already have calculated average, count, and variance for your samples(Tip:use a PivotTable), then you can use these user-defined functions to calculate the t-test stat value and degrees of freedom required to do hypothesis testing. Both the functions provide an optional argument for the assumption of equal variances; by default it is set to false.

Here’s the code for t-test:

'---------------------------------------------------------------------------------------
' Procedure : TTESTM
' DateTime  : 10/29/2008 08:35
' Author    :
' Purpose   : To get the t-stat value when comparing two means with an optional input
'               for equal or unequal variances
'               by default the function assumes that the user is comparing means with unequal variances
' davg1 is the mean of first sample
' dcnt1 is the sample size of sample 1 
' dvar1 is the variance of first samaple 
' davg2 is the mean of second sample
' dcnt2 is the sample size of sample 2 
' dvar2 is the variance of second samaple 
' blnEqVar set TRUE to assume equal variance for the test
'---------------------------------------------------------------------------------------

Public Function TTESTM(davg1 As Double, dcnt1 As Double, dvar1 As Double, davg2 As Double, dcnt2 As Double, dvar2 As Double, Optional blnEqVar As Boolean = False) As Double
 
On Error GoTo TTESTM_Error
Dim dResult As Double, dNumer As Double, dDenon As Double, dPooledVar As Double
 
dNumer = davg1 - davg2
 
'if equal variances are not assumed
'http://www.itl.nist.gov/div898/handbook/eda/section3/eda353.htm
If Not blnEqVar Then
	dDenon = Sqr((dvar1 ^ 2 / dcnt1) + (dvar2 ^ 2 / dcnt2))
Else
'if equal variances are assumed, then calculated the pooled variance
	dPooledVar = Sqr((((dcnt1 - 1) * dvar1 ^ 2) + ((dcnt2 - 1) * dvar2 ^ 2)) / (dcnt1 + dcnt2 - 2))
	dDenon = dPooledVar * Sqr((1 / dcnt1) + (1 / dcnt2))
End If
 
dResult = dNumer / dDenon
 
TTESTM = dResult
Exit Function
 
TTESTM_Error:
	TTESTM = Null
 
End Function

Code for degrees of freedom

'---------------------------------------------------------------------------------------
' Procedure : DOFTTESTM
' DateTime  : 10/29/2008 08:50
' Author    :
' Purpose   : To get the degrees of freedom for the t-test when comparing two means with an optional input
'               for equal or unequal variances
'               by default the function assumes that the user is comparing means with unequal variances

' dcnt1 is the sample size of sample 1 
' dvar1 is the variance of first samaple 
' dcnt2 is the sample size of sample 2 
' dvar2 is the variance of second samaple 
' blnEqVar set TRUE to assume equal variance for the test
'---------------------------------------------------------------------------------------
'
Public Function DOFTTESTM(dcnt1 As Double, dvar1 As Double, dcnt2 As Double, dvar2 As Double, Optional blnEqVar As Boolean = False) As Double
 
Dim dResult As Double, dNumer As Double, dDenon As Double
 
On Error GoTo DOFTTESTM_Error
'if equal variances are not assumed, then use a complicated formula to compute degrees of freedom
'http://www.itl.nist.gov/div898/handbook/eda/section3/eda353.htm
If Not blnEqVar Then
	dNumer = ((dvar1 ^ 2 / dcnt1) + (dvar2 ^ 2 / dcnt2)) ^ 2
	dDenon = ((dvar1 ^ 2 / dcnt1) ^ 2 / (dcnt1 - 1)) + ((dvar2 ^ 2 / dcnt2) ^ 2 / (dcnt2 - 1))
	dResult = dNumer / dDenon
Else
	dResult = dcnt1 + dcnt2 - 2
End If
 
DOFTTESTM = dResult
 
Exit Function
 
DOFTTESTM_Error:
	DOFTTESTM = Null
 
End Function
Posted in String Operations, Useful Procedures - Tagged , ,

Excel Training Handout

Oct23
2007 1 Comment Written by admin

Recently, I conducted a training session for Ohio Association for Institutional Research and Planning (OAIRP). Here are the files that I used for the training:

Convert Text to Uppercase

Sep17
2007 2 Comments Written by admin

If you want to convert the text to uppercase, use the following code; however, I recommend downloading ASAP Utilities, it has many functionalities, including text conversion. It doesn’t offer source code though.

Here’s my code for uppercase conversion:
(If you want to convert your text to lowercase, replace Ucase with Lcase function in the code)

‘Will convert selected range to Upper case, using array
Sub Conv2UCase()
On Error GoTo Conv2UCase_Error

Dim vDataArr As Variant
Dim lUpperBndRow As Long, lUpperBndCol As Long
Dim lRow As Long, lCol As Long

‘store selected values in an array
vDataArr = Selection
‘get the upper bound of rows
lUpperBndRow = UBound(vDataArr, 1)
‘get the upper bound of cols
lUpperBndCol = UBound(vDataArr, 2)

‘Start a loop to go through all the elements of the array
For lRow = 1 To lUpperBndRow
    For lCol = 1 To lUpperBndCol
        ‘Check if the value is text, if not don’t convert
        If WorksheetFunction.IsText(vDataArr(lRow, lCol)) Then
            ‘Convert values to upper case
            vDataArr(lRow, lCol) = UCase(vDataArr(lRow, lCol))
        End If
    Next lCol
Next lRow
‘Return the converted values to the range
Selection = vDataArr
Exit Sub

Conv2UCase_Error:
    MsgBox “Error ” & Err.Number & ” (” & Err.Description & “) in Sub:Conv2UCase”
End Sub

Posted in String Operations, Useful Procedures - Tagged , ,

Print Structures of dbf files in separate workbooks

Jul24
2007 Leave a Comment Written by admin

Recently, I had the need of printing the data structures of many dbf files. A google search reveled the DBF.COM file that would output dbf file structures, number of records, file name, date of last update, etc.

Download this file here: files/DBF.COM (Caution: I downloaded this file from the internet, and I do not make any warranty of it being spyware or malicious ware free. Use it on your own risk.)

To use this file go to Start>Run>cmd and in DOS type:

cd C:/

dbf.com > myfilestru.txt

Note: cd is used to change the current directory

Here’s a print screen:

This will create a file myfilestru.txt in the same directory where your dbf files are residing. This text file will look like this:

Now, that we have a text file all the file structures, we need to create separate workbooks for each dbf file. To do that open this text file in Excel, press Alt + F11 to view the VBA window, double-click the sheet name, and paste this code. After that run this code, and you should have separate workbooks for each dbf file.

Sub FormatThisFile()
‘Define some variables
Dim iLastRow As Integer, i As Integer, sWrkbkNm As String, sNewWrkbkNm As String
Dim iPrevLastRow As Integer, iFirstRow As Integer, iNewWrkbkRow As Integer

On Error GoTo FormatThisFile_Error
‘Turn off the screen update to run the macro faster
Application.ScreenUpdating = False

‘Refer to the current workbook and sheet1
With ThisWorkbook.Sheets(1)
    ‘get the last row number
    iLastRow = .Range(“A65536″).End(xlUp).Row
    i = 1
    Do While i < iLastRow
        ‘search for string “Structure for”
        If InStr(1, .Range(“A” & i), “Structure for”) > 0 Then
            ‘if found then store the file name
            sWrkbkNm = Trim(Right(.Range(“A” & i), Len(.Range(“A” & i)) – Application.WorksheetFunction.Find(“:”, .Range(“A” & i))))
            sWrkbkNm = Left(sWrkbkNm, Len(sWrkbkNm) – 4)
            iFirstRow = i
        ‘search for string “** Total **”
        ElseIf InStr(1, .Range(“A” & i), “** Total **”) > 0 Then
            iPrevLastRow = i
            ‘add a workbook
            Workbooks.Add
            ‘save it
            ActiveWorkbook.SaveAs ThisWorkbook.Path & “\” & sWrkbkNm
            sNewWrkbkNm = sWrkbkNm & “.xls”
            ‘with this new workbook do copy-paste
            With Workbooks(sNewWrkbkNm)
                ThisWorkbook.Sheets(1).Range(“A” & iFirstRow & “:” & “A” & iPrevLastRow).Copy Destination:= _
                .Sheets(1).Range(“A1″)
                iNewWrkbkRow = .Sheets(1).Range(“A65536″).End(xlUp).Row
                .Sheets(1).Range(“A4:A” & iNewWrkbkRow).TextToColumns Destination:= _
                .Sheets(1).Range(“A4″), DataType:=xlDelimited, Space:=True
                .Sheets(1).Range(“A5:A” & iNewWrkbkRow – 1).Delete Shift:=xlToLeft
                .Sheets(1).Columns(“A:IV”).EntireColumn.AutoFit
                .Sheets(1).Columns(“A:IV”).WrapText = False
                ‘save and close this workbook
                .Save
                .Close
            End With
        End If
        i = i + 1
    Loop
    MsgBox “Done”
End With

On Error GoTo 0
SmoothExit_FormatThisFile:
    Application.ScreenUpdating = True
    Exit Sub

FormatThisFile_Error:
    MsgBox “Er
ror ” & Err.Number & ” (” & Err.Description & “) in procedure FormatThisFile”
    Resume SmoothExit_FormatThisFile

End Sub

Tagged , , ,
« Older Entries Newer Entries »