I created the following macro and tested it against some sample data I had.
It was a rather large sample:
143,774 rows
100 columns
They were Requisitions written by 191 users.
The macro moved all 143,774 rows to 191 sheets in
1 minute, 32 seconds.
I utilized a Dictionary object for a sheet array to keep a list of the sheets
(rather than loop through the Sheets object)
If you need help understanding my approach or adapthing this to your needs, let
me know.
======================================
======================================
Option Explicit
Sub Clear_Sheets()
Dim Sht
Application.DisplayAlerts = False
For Each Sht In Sheets
If (Sht.Name <> "Data") Then
Sht.Delete
End If
Next Sht
Application.DisplayAlerts = True
End Sub
Sub Split_Sheets()
Dim USRid, Sht
Dim nRows, R, dRow
Dim Dict_Sheets
Dim tstart, tstop, TElapsed, TMin, TSec, msg
'--------------------------------------------------
' ThisWorkbook.Save
'--------------------------------------------------
tstart = Timer
'--------------------------------------------------
Set Dict_Sheets = CreateObject("Scripting.Dictionary")
Dict_Sheets.RemoveAll
For Each Sht In Sheets
If (Not Dict_Sheets.exists(Sht.Name)) Then
Dict_Sheets.Add Sht.Name, Sheets.Count
End If
Next Sht
'------------------------------
On Error Resume Next
Application.ScreenUpdating = False
Sht = "Data"
nRows = Application.WorksheetFunction.CountA(Sheets(Sht).Range("A:A"))
Application.ScreenUpdating = True
For R = 2 To nRows
If (R Mod 1000 = 0) Then Application.StatusBar = "Processing " & R & "
of " & nRows
USRid = UCase(Sheets(Sht).Cells(R, "A").Value)
If (Not Dict_Sheets.exists(USRid)) Then
Sheets.Add after:=Sheets(Sht)
ActiveSheet.Name = USRid
Sheets(USRid).Range("A1:CV1") = Sheets(Sht).Range("A1:CV1").Value
Sheets(Sht).Select
Dict_Sheets.Add USRid, Sheets.Count
End If
dRow = Application.WorksheetFunction.CountA(Sheets(USRid).Range("A:A"))
+ 1
Sheets(USRid).Range("A" & dRow & ":CV" & dRow) = Sheets(Sht).Range("A"
& R & ":CV" & R).Value
Next R
Application.StatusBar = False
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
msg = "Processed " & R & " Rows" & Chr(13) & "To Create " &
Sheets.Count - 1 & " sheets in:"
tstop = Timer
TMin = 0
TElapsed = tstop - tstart
TMin = TElapsed \ 60
TSec = TElapsed Mod 60
msg = msg & Chr(13) & Chr(13)
If (TMin > 0) Then msg = msg & TMin & " mins "
msg = msg & TSec & " sec"
MsgBox msg
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
End Sub
Paul
-----------------------------------------
“Do all the good you can,
By all the means you can,
In all the ways you can,
In all the places you can,
At all the times you can,
To all the people you can,
As long as ever you can.” - John Wesley
-----------------------------------------
From: "waitingtohea...@gmail.com" <waitingtohea...@gmail.com>
>To: excel-macros@googlegroups.com
>Sent: Thursday, February 26, 2015 6:57 PM
>Subject: $$Excel-Macros$$ Re: Creating new sheet for each person and
>transferring their data
>
>
>
>I am trying to do this exact same thing but within Google Sheets.
>
>
>need this same code structure but within Googles javascript format I assume. I
>don't think I can just take this excel script and use it correct?
>
>
>
>
>On Sunday, June 6, 2010 at 9:29:52 PM UTC-7, Amanda wrote:
>Hi all,
>>
>>I'm stuck on a macro I'm working on. I'm uploading an example sheet.
>>
>>I have a list of data - the first column has the person's name - each
>>person can have any number of rows.
>>
>>I need the macro to create a new tab with the name of the person
>>(which is the entry in the 'A' column) and and to copy over all of the
>>rows for that person. In the end I want the first page with all the
>>data, and then a tab for each person with their data in it. It would
>>be safest to copy the entire row - the number of columns with data may
>>change.
>>
>>Thanks,
>>Amanda
--
>Are you =EXP(E:RT) or =NOT(EXP(E:RT)) in Excel? And do you wanna be? It’s
>=TIME(2,DO:IT,N:OW) ! Join official Facebook page of this forum @
>https://www.facebook.com/discussexcel
>
>FORUM RULES
>
>1) Use concise, accurate thread titles. Poor thread titles, like Please Help,
>Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will not get
>quick attention or may not be answered.
>2) Don't post a question in the thread of another member.
>3) Don't post questions regarding breaking or bypassing any security measure.
>4) Acknowledge the responses you receive, good or bad.
>5) Jobs posting is not allowed.
>6) Sharing copyrighted material and their links is not allowed.
>
>NOTE : Don't ever post confidential data in a workbook. Forum owners and
>members are not responsible for any loss.
>---
>You received this message because you are subscribed to the Google Groups "MS
>EXCEL AND VBA MACROS" group.
>To unsubscribe from this group and stop receiving emails from it, send an
>email to excel-macros+unsubscr...@googlegroups.com.
>To post to this group, send email to excel-macros@googlegroups.com.
>Visit this group at http://groups.google.com/group/excel-macros.
>For more options, visit https://groups.google.com/d/optout.
>
>
>
--
Are you =EXP(E:RT) or =NOT(EXP(E:RT)) in Excel? And do you wanna be? It’s
=TIME(2,DO:IT,N:OW) ! Join official Facebook page of this forum @
https://www.facebook.com/discussexcel
FORUM RULES
1) Use concise, accurate thread titles. Poor thread titles, like Please Help,
Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will not get
quick attention or may not be answered.
2) Don't post a question in the thread of another member.
3) Don't post questions regarding breaking or bypassing any security measure.
4) Acknowledge the responses you receive, good or bad.
5) Jobs posting is not allowed.
6) Sharing copyrighted material and their links is not allowed.
NOTE : Don't ever post confidential data in a workbook. Forum owners and
members are not responsible for any loss.
---
You received this message because you are subscribed to the Google Groups "MS
EXCEL AND VBA MACROS" group.
To unsubscribe from this group and stop receiving emails from it, send an email
to excel-macros+unsubscr...@googlegroups.com.
To post to this group, send email to excel-macros@googlegroups.com.
Visit this group at http://groups.google.com/group/excel-macros.
For more options, visit https://groups.google.com/d/optout.
