Splitting Sheets

[bluebonnet]

Hello,

I am looking to use macros to help with data analysis on a survey. I have a big survey that the results are all located in one sheet, but I want to be able to run a macro that will split the data into sheets based on one variable. For example, if a survey question asks for zip code, I'd like the big sheet (full of all the data) to be split into additional sheets by each zip code. Every zip code responded would get their own sheet, and all of the data for each respondent who identified with that zip code would go into that specific sheet. All of the original data would also remain in the main big sheet. Is there a macro I can write to do this?

Thank you in advance!

[JKwan]

Here is something that I whipped up.

[bluebonnet]

Thank you JKwan for your reply! Is there a way to then split for instance all of the responses with "12345" as their zip code into their own sheet called 12345?

[JKwan]

yes, just put that into the WHERE clause:



" ([ZipCode] = 12354" & ")"

[JKwan]

sorry, read too fast, here is the updated code. just replace


Sub GetPivotSourceData()
Dim sSQL As String
Dim stcon As String
Dim objConnection As ADODB.Connection
Dim objRecordSet As ADODB.Recordset
Dim Index As Long
Dim LastRow As Long
Dim FullWorkBookName As String
Dim WS As Worksheet
Dim WB As Workbook
Dim lZipcode As Long

Set objConnection = CreateObject("ADODB.Connection")
Set objRecordSet = CreateObject("ADODB.Recordset")

stcon = "Provider = Microsoft.ACE.OLEDB.12.0; " & _
"Data Source=" & ThisWorkbook.FullName & ";" & _
"Extended Properties=""Excel 8.0;"""

lZipcode = InputBox("Enter Zip code ")
sSQL = "Select " & _
s01 & s02 & s03 & s04 & s05 & s06 & s07 & _
" From [MasterData$] Where " & _
" ([ZipCode] = " & lZipcode & ")" ' <--- since zip is numeric
' <--- if alpha, need to enclose with ''
objRecordSet.Open sSQL, stcon, , adLockOptimistic
Set WB = ThisWorkbook
If Not objRecordSet.EOF Then
Set WS = WB.Worksheets.Add
WS.Name = "Zipcode - " & lZipcode
With WS

.Range("A2").CopyFromRecordset objRecordSet
.Range("A1:G1") = Array("LastName", "FirstName", "Question1", _
"Question2", "Question3", "Question4", "ZipCode")

End With
Else
MsgBox "None Found"
End If
End Sub

[bluebonnet]

Awesome! This worked perfectly. Thank you for your help!!!

[JKwan]

Anytime, glad to help