Dynamic Macro Input

  • Thread starter Thread starter Craig
  • Start date Start date
C

Craig

I am trying to create a Macro that will sort a multi-column, multi-row
set of data. Sorting on one column is simple using the Excel built in
sort function. Once the sorting is complete, I would like the macro
to take each unique set of data, by row, and create a new spreadsheet
with just that data included.

What I am finding difficult is to have the macro dynamically sense
which data belongs together, then copy and paste it into a new sheet.
Is there some stock code that someone has to do this or is there a
function in Excel that I can readily use? I've been stumped by this
for a while.

Thanks in advance!

craig.
 
Craig

I think you're going to have to tell us what the rules are so that we know
"which data belongs together"

Are you saying that you need a new sheet for each row of data ?

Something like this might do what you want:

Sub NewSheets()
Dim LastRow As Long
Dim i As Long
LastRow = Range("A65536").End(xlUp).Row
For i = 1 To LastRow
Set NewSheet = Worksheets.Add(after:=Worksheets(Worksheets.Count))
NewSheet.Name = "data " & i
Sheets("Sheet1").Range("A" & i).EntireRow.Copy NewSheet.Range("A1")
Next 'i
End Sub

Assumes that the "master" sheet is Sheet1

Regards

Trevor
 
Thanks for the feedback so far. This looks like it might be along the
lines of what I need.

Based upon an initial sort that I do (this will be part of the macro),
I am able to see that there should be anywhere from 1-10 rows that
belong together (same data value) in a new sheet.

Seems like I need to scan the document to determine which rows belong
together, create a new sheet, copy the data there and start the
process again until all the rows have been copied to new sheets. Does
this help?

Thanks in advance!

craig.
 
Craig

try something like this:

Sub CreateNewSheets()
Dim MasterSheet As Worksheet
Dim NewSheet As Worksheet
Dim LastRow As Long
Dim i As Long
On Error Resume Next
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set MasterSheet = Worksheets("Sheet1")
With MasterSheet
LastRow = .Range("A65536").End(xlUp).Row
.Range("A1").Sort _
Key1:=.Range("A2"), _
Order1:=xlAscending, _
Header:=xlYes, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom
End With
With MasterSheet
For i = 2 To LastRow
If .Range("A" & i) <> .Range("A" & i).Offset(-1, 0) Then
Set NewSheet =
Worksheets.Add(after:=Worksheets(Worksheets.Count))
NewSheet.Name = MasterSheet.Range("A" & i).Value
.Range("A1").EntireRow.Copy NewSheet.Range("A1")
End If
.Range("A" & i).EntireRow.Copy
With NewSheet
.Range("A65536").End(xlUp).Offset(1, 0).Select
.Paste
Application.CutCopyMode = False
End With
Next 'i
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
On Error GoTo 0
End Sub

Probably not the most efficient but it should be OK for a relatively small
number of rows. Note that if it is rerun it won't name the worksheets. It
would be better to build a range to be copied and then copy and paste once
for each change of key value ... but that can be your challenge !

Regards

Trevor
 
Back
Top