Reputation: 145
I have a worksheet with over 8,000 rows and each one as 1 of 29 words as an identifier in column A. I would like to write a VBA script that will parse all of the rows, group them by the identifier in column A and export each group into a new work sheet and name each worksheet as its identifier
For example if this is my data:
Column A Column B Column C
X cat blue
Y dog red
Z bird green
Y whale yellow
Z tiger black
X wolf purple
I would like this output for Sheet 1 named X:
Column A Column B Column C
X cat blue
X wolf purple
I would like this output for Sheet 2 named Y:
Column A Column B Column C
Y dog red
Y whale yellow
And this output for Sheet 3 named Z:
Column A Column B Column C
Z bird green
Z tiger black
Upvotes: 0
Views: 2772
Reputation: 29421
you could use AutoFilter()
methods of Range
object, as follows:
Option Explicit
Sub main()
Dim helperCol As Range, cell As Range
With Worksheets("Data") '<--| reference your relevant sheet (change "Data" to your actual sheet name)
Set helperCol = .UsedRange.Resize(, 1).Offset(, .UsedRange.Columns.COUNT) '<--| set a "helper" range where to store unique identifiers
With .Range("C1", .Cells(.Rows.COUNT, 1).End(xlUp).Offset(1)) '<-- reference its "data" range from cell "A1" to last not empty cell in column "C"
helperCol.Value = .Resize(, 1).Value '<--| copy identifiers to "helper" range
helperCol.RemoveDuplicates Columns:=1, Header:=xlYes '<--| remove duplicates in copied identifiers
For Each cell In helperCol.Resize(helperCol.Rows.COUNT - 1).Offset(1).SpecialCells(xlCellTypeConstants) '<--| loop through unique identifiers, skipping header
.AutoFilter Field:=1, Criteria1:=cell.Value '<--| filter "data" on identifiers column with current (unique) identifier
.SpecialCells(xlCellTypeVisible).Copy Destination:=GetOrCreateSheet(cell.Value).Range("A1") '<--| copy filtered data (skipping header) and paste it to corresponding sheet starting from its column "A" first not emtpy cell
Next cell
End With
.AutoFilterMode = False '<--| show all rows back
helperCol.ClearContents '<--| clear "helper" range
End With
End Sub
Function GetOrCreateSheet(shtName As String) As Worksheet
On Error Resume Next
Set GetOrCreateSheet = Worksheets(shtName)
If GetOrCreateSheet Is Nothing Then
Set GetOrCreateSheet = Worksheets.Add
GetOrCreateSheet.name = shtName
Else
GetOrCreateSheet.Cells.ClearContents
End If
End Function
Upvotes: 1
Reputation: 107567
Should you use Excel for Windows, you can access the Jet/ACE SQL Engine via ADO ODBC and run SQL queries to achieve needs. And yes, you can query the current workbook (last saved instance):
Sub RunSQL()
Dim conn As Object, rst As Object
Dim strConnection As String, strSQL As String
Dim i As Integer, fld As Object
Dim WS As Worksheet, var As Variant
Set conn = CreateObject("ADODB.Connection")
Set rst = CreateObject("ADODB.Recordset")
' STRING CONNECTION (TWO VERSIONS)
' strConnection = "DRIVER={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" _
' & "DBQ=C:\Path\To\Workbook.xlsm;"
strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" _
& "Data Source='C:\Path\To\Workbook.xlsm';" _
& "Extended Properties=""Excel 8.0;HDR=YES;"";"
' OPEN DB CONNECTION
conn.Open strConnection
For Each var In Array("X", "Y", "Z")
' CREATE WORKSHEET
Set WS = ActiveWorkbook.Sheets.Add(After:=Worksheets(Worksheets.Count))
WS.Name = var
' SQL STATEMENT
strSQL = " SELECT [Sheet1$].[Column A], [Sheet1$].[Column B]," _
& " [Sheet1$].[Column C]" _
& " FROM [Sheet1$]" _
& " WHERE [Sheet1$].[Column A] = '" & var & "';"
' OPEN RECORDSET
rst.Open strSQL, conn
' COLUMN HEADERS
WS.Range("A1").Activate
For i = 1 To rst.Fields.Count
WS.Cells(1, i) = rst.Fields(i - 1).Name
Next i
' DATA ROWS
WS.Range("A2").CopyFromRecordset rst
rst.Close
Next var
conn.Close
Set rst = Nothing: Set conn = Nothing
End Sub
Upvotes: 0
Reputation: 744
You've got a bit of a multi-step problem here. Have you written up any code so far? If you've run into any specific errors, post them here and we'll gladly provide more specific advice.
For now, I would recommend breaking up your problem into its component features. You can then proceed to work on, seek help with, and complete each of these parts on their own and tie them all together at the end.
A recommended step-by-step approach:
Step 1: Looping through a range.
Step 2: Parse and save the results.
A starting place for learning about VBA conditional statements.
A starting place for learning about VBA arrays.
Step 3: Adding and naming a new worksheet.
A previous Stack Overflow answer.
Step 4: Placing your stored information onto your new sheet.
Good luck!
Upvotes: 0