Don’t you hate it when you are working with many fields and you want to filter a particular field, so you apply auto filter on the all fields, but you find out that the field you were working on is gone from your sight and you see A1 cell. I did. Not anymore.
Solution: Simply hit the left or the right arrow key, and it will take you to the left or the right cell of the field you were working on.
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
Written by
Recent Comments