Need to create new sheets and move data to each sheet

[hank3rd]

Hello,

I was hoping that someone could point me in the right direction. I am decent with macros, but creating them from scratch is where I struggle. I enjoy learning how to adapt code that I find on this forum and making then work for my needs.

This time, I have a situation where I have two needs and cannot get the two solutions to work together.

I have an excel file that lists report data based on regions. I would like to:

1. Create new sheets based on the region name
2. Move the row data to the correct new sheet based on "region"

I figured that I could move the list of regions to a new sheet and create unique values and make sure they are de-duplicated, then create new sheets based on the list.

I then found information on how to move data to a new sheet based on cell information here: https://www.mrexcel.com/forum/excel-questions/673106-move-row-into-new-sheet-based-cell-value.html.
But it seems to work with one sheet?

Sub Cheezy()
'move rows from sheet 1 to sheet 2 if column E has a Yes in it.
'for http://www.mrexcel.com/forum/excel-q...ell-value.htmlDim Check As Range
Lastrow = Worksheets("Sheet1").UsedRange.Rows.Count
lastrow2 = Worksheets("Sheet2").UsedRange.Rows.Count
If lastrow2 = 1 Then
lastrow2 = 0
Else
End If
Do While Application.WorksheetFunction.CountIf(Range("E:E"), "Yes") > 0
Set Check = Range("E1:E" & Lastrow)
For Each Cell In Check
If Cell = "Yes" Then
Cell.EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & lastrow2 + 1)
Cell.EntireRow.Delete
lastrow2 = lastrow2 + 1
Else:
End If
Next
Loop
End Sub
I can provide more information as needed.

Here is sample data:

[TABLE="width: 434"]
<colgroup><col width="141" style="width: 106pt;"><col width="88" span="2" style="width: 66pt;"><col width="117" style="width: 88pt;"></colgroup><tbody>[TR]
[TD="width: 141"]First Name[/TD]
[TD="width: 88"]Last Name[/TD]
[TD="width: 88"]Division[/TD]
[TD="width: 117"]Region[/TD]
[/TR]
[TR]
[TD]Catherine[/TD]
[TD]Smith[/TD]
[TD]West[/TD]
[TD]Texas[/TD]
[/TR]
[TR]
[TD]Cathy[/TD]
[TD]Armstrong[/TD]
[TD]West[/TD]
[TD]Texas[/TD]
[/TR]
[TR]
[TD]Chris[/TD]
[TD]Spencer[/TD]
[TD]West[/TD]
[TD]Texas[/TD]
[/TR]
[TR]
[TD]Darin[/TD]
[TD]Klaehn[/TD]
[TD]West[/TD]
[TD]Texas[/TD]
[/TR]
[TR]
[TD]David[/TD]
[TD]Himel[/TD]
[TD]West[/TD]
[TD]Texas[/TD]
[/TR]
[TR]
[TD]Greg[/TD]
[TD]Stowe[/TD]
[TD]West[/TD]
[TD]Texas[/TD]
[/TR]
[TR]
[TD]Jessica[/TD]
[TD]Jackson[/TD]
[TD]West[/TD]
[TD]Texas[/TD]
[/TR]
[TR]
[TD]Pete[/TD]
[TD]Rodriguez[/TD]
[TD]West[/TD]
[TD]Texas[/TD]
[/TR]
[TR]
[TD]Stephen[/TD]
[TD]Fine[/TD]
[TD]West[/TD]
[TD]Texas[/TD]
[/TR]
[TR]
[TD]Steve[/TD]
[TD]Hisamoto[/TD]
[TD]West[/TD]
[TD]Texas[/TD]
[/TR]
</tbody>[/TABLE]




Any help would be appreciated!

 

[Fluff]

How about

Sub CopyToSheets()
   Dim Cl As Range
   Dim Ws As Worksheet
   
   Set Ws = ActiveSheet
   If Ws.AutoFilterMode Then Ws.AutoFilterMode = False
   With CreateObject("scripting.dictionary")
      For Each Cl In Ws.Range("D2", Ws.Range("D" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value) Then
            Sheets.Add(, Sheets(1)).Name = Cl.Value
            .Add Cl.Value, Nothing
            Ws.Range("A1").AutoFilter 4, Cl.Value
            Ws.AutoFilter.Range.SpecialCells(xlVisible).Copy Sheets(Cl.Value).Range("A1")
         End If
      Next Cl
   End With
   Ws.AutoFilterMode = False
End Sub

 

[hank3rd]

@Fluff, Thank you. For "scripting.dictionary", what do I need to declare? I am getting a scripting error when I leave it or declare a column.

 

[Fluff]

You don't need to declare it.
What error message are you getting & what line is highlighted?

 

[hank3rd]

Runtime error 429

Active X Component cannot create object.

On line: With CreateObject("scripting.dictionary")

I had more columns in my file that I deleted for privacy. I changed the "D"s to J. That was all.

This should run with the data that I provided, right? I do not need to grab the regions and de-dup?

Also, I am running this on a Mac? Is there an issue with ActiveX on a Mac?

 

[Fluff]

You cannot run ActiveX on a Mac.
As I don't have a Mac I cannot help any further.

 

[hank3rd]

I can try on a PC tomorrow and report back. Thank you!

 

[hank3rd]

@Fluff, I ran it on a pc and at first had an error. I found about 10 rows at the end of the data that did not have a region defined, causing an error. I deleted the rows and it ran without error.

The only thing left now is that the header row was copied over, but not of the data. I am thinking that it has something to do with the Range A1? Also, once it runs, all of the data is also missing from the main sheet.

I appreciate the help so far. I need to analyze some of the lines to learn more about the variables and such you provided. I understand what is happening, but would not be able to easily built this from scratch. Still learning!

 

[hank3rd]

I think I got it. I provided 4 columns of sample data, when there was actually 10 in the file. I changed it and it ran well. I will test further. You are a life saver!

 

[Fluff]

Deleted, seen post#9

If you want more info on dictionaries, have a look here.