Need help with VBA - complicated copy and paste

[Vegas Lady]

I have to admit that I am totally out of my depth with this one. I'm
working with Excel 2007. I have worksheet (Master Sheet) that
contains a list of data; depending on the input the number of rows can
be 15 or 500. There are a total of 19 columns, but columns A and B
are key. Column A contains dates and Column B is text. What I need
is to automate the following:

From the "Master Sheet", look at Columns A and B. For every unique
combination, copy those rows into a new worksheet that is named
"Column A, Column B". If that new combination worksheet already
exists, then delete the exsting worksheet and insert a new one.

For example, Column A contains a list of dates and Column B is a list
of place names. I need to create a new worksheet that takes from the
"MasterSheet", all rows that are January 20 and Seattle in columns A &
B and rename the new sheet "20 January Seattle" Depending on how many
rows of data, this could create 5 to 50 new worksheets.

I've been successful in copying & renaming one worksheet, but I can't
conditionally copy the data and I can't seem to copy multiple
sheets.

Any and all help is appreciated.

 

[Bob Bridges]

Erica, when you say you're out of your depth do you mean you don't know how
to write programming logic in general or just that you don't know the
properties and methods you need for these particular operations? If you mean
the former, it'll take more than just a quick reply to walk you through it;
feel free to email me and I'll spend some time teaching you, or maybe you can
just pick it up a piece at a time. But if all you're missing is a few
methods or techniques, here's a quick list:

ra=2
rz=Me.Cells(ra,1).End(xlDown).Row

So your data starts on row 2, and we used <End><Down> to find the last data
row. That's assuming there are no blank cells in col A.

For jr=ra to rz 'loop through all the data rows
WSName=Me.Cells(jr,1).Value & Me.Cells(jr,2).Value 'new worksheet name
set NewSheet = Me.Worksheets.Add 'create new worksheet
NewSheet.Name = WSName 'set the name of the new sheet
Next jr

This creates the new worksheets, but there are a couple missing pieces.
First, you want to check before creating the new worksheet to be sure one
doesn't already exist by that name. Someone else may know a better way, but
in my experience that takes an extra function that does error checking.
Second, you don't want to create a new worksheet for EVERY occurrence of "20
January" and "Seattle"; if that occurs four times you just one one worksheet
for it. And third, none of this transfers any data to the new sheets. But
it's a start. Can you take it from there, or do you need more?

 

[joel]

This code is fully tested


Code
-------------------
Sub MoveBlocks()

Set SourceSht = Sheets("Sheet1")

With SourceSht
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
StartRow = 1

'sort the data
.Rows(StartRow & ":" & LastRow).Sort _
header:=xlYes, _
key1:=.Range("A1"), _
order1:=xlAscending, _
key2:=.Range("B1"), _
order2:=xlAscending

'start row is the first row of each new unique combination a, B
StartRow = StartRow + 1
For RowCount = StartRow To LastRow
If .Range("A" & RowCount) <> .Range("A" & (RowCount + 1)) Or _
.Range("B" & RowCount) <> .Range("B" & (RowCount + 1)) Then

NewShtName = .Range("A" & RowCount) & ", " & _
.Range("B" & RowCount)

'find sheet name
Found = False
For Each sht In Sheets
If sht.Name = NewShtName Then
Application.DisplayAlerts = False
sht.Delete
Application.DisplayAlerts = True
Exit For
End If
Next sht

'add new sht
Set NewSht = Sheets.Add(after:=Sheets(Sheets.Count))
'change name of sheet
NewSht.Name = NewShtName

'copy Header Row
.Rows(1).Copy Destination:=NewSht.Rows(1)

'copy data
Set CopyRange = .Rows(StartRow & ":" & RowCount)
Set DestRange = NewSht.Rows(2)
CopyRange.Copy Destination:=DestRange

'move the start of the next block
StartRow = RowCount + 1
End If
Next RowCount
End With

End Su

 

[Vegas Lady]

Thank you so much Joel & Bob. Your suggestions helped so much and
Joel, the code worked perfectly. Much appreciated!