Reformat Data with Macro

[joeyc]

Hello,

I was wondering if anyone could create a quick macro here. I will describe what I am looking for below. Also, I have attached a sample to make things easier.

1- I have workbook with many worksheets. The worksheet of interest is named 'MOVEHOLDINGS.'
2- The worksheet called 'MOVEHOLDINGS' has 9 fields in columns A --> I. The number of rows in 'MOVEHOLDINGS' is undefined.
3- I would like to reformat the data on this worksheet in a special way. I would like to transfer each unique name given in field 2 to a new worksheet. The name for the new worksheet should be the unique name in Field 2. In this case, 3 new worksheets will be created. However, I would like all of these worksheets to appear in a new workbook.
4- To summarize, the way I see this working is, I will run a macro on a workbook that contains a worksheet called 'MOVEHOLDINGS.' The macro will then rearrange the data on 'MOVEHOLDINGS' in a new workbook. Each unique name in field two will be on a separate sheet. Each worksheet will bear the name of the name given in Field 2.

One issue to consider is what if the name given in Field 2 is too long to be used as the name for the worksheet tab. I don't know how I would handle that.

[mdmackillop]

Option Explicit
Sub Macro1()
Dim ThsSht As Worksheet
Dim wb As Workbook
Dim Rw As Long, i As Long

Set ThsSht = ActiveSheet
Columns("B:B").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("P1"), Unique:=True
Rw = Cells(Rows.Count, "P").End(xlUp).Row
Set wb = Workbooks.Add

For i = 1 To wb.Sheets.Count
wb.Sheets(i).Name = ThsSht.Cells(i + 1, "P").Value
Next
For i = wb.Sheets.Count + 1 To Rw - 1
wb.Sheets.Add After:=wb.Sheets(Sheets.Count)
wb.Sheets(i).Name = ThsSht.Cells(i + 1, "P")
Next
ThsSht.Columns(16).ClearContents
End Sub

[Norie]

Something like this perhaps.

Sub DistributeRowsToNewWB()
Dim wbNew As Workbook
Dim wsData As Worksheet
Dim wsCrit As Worksheet
Dim wsNew As Worksheet
Dim rngCrit As Range
Dim LastRow As Long

Set wsData = Worksheets("MOVEHOLDINGS") ' name of worksheet with the data
Set wsCrit = Worksheets.Add

LastRow = wsData.Range("A" & Rows.Count).End(xlUp).Row

' column H has the criteria
wsData.Range("B1:B" & LastRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wsCrit.Range("A1"), Unique:=True

Set rngCrit = wsCrit.Range("A2")
While rngCrit.Value <> ""
Set wsNew = Worksheets.Add
' change E to reflect columns to copy
wsData.Range("A1:I" & LastRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rngCrit.Offset(-1).Resize(2), CopyToRange:=wsNew.Range("A1"), Unique:=True

If wbNew Is Nothing Then
wsNew.Copy
Set wbNew = ActiveWorkbook
wbNew.Worksheets(wbNew.Worksheets.Count).Name = rngCrit
Else
wsNew.Copy after:=wbNew.Worksheets(wbNew.Worksheets.Count)
wbNew.Worksheets(wbNew.Worksheets.Count).Name = rngCrit
End If

Application.DisplayAlerts = False
wsNew.Delete
rngCrit.EntireRow.Delete
Set rngCrit = wsCrit.Range("A2")
Wend

wbNew.SaveAs ThisWorkbook.Path & "\New Workbook"
'wbNew.Close SaveChanges:=True

wsCrit.Delete
Application.DisplayAlerts = True

End Sub

[joeyc]

Thank you for the reply MDMACKILOP. There are a few issues here

1- The data was not transferred over here. If you refer to my sample, the first sheet in the workbook is supposed to be the before. The next 3 sheets are supposed to be the after, in a new workbook of course.
2- An issue did surface with the names of the sheets. I can prevent the user from entering unacceptable Excel characters like '.' or '/', but still have a problem with the string length. In Excel, you can only use 31 characters in naming a sheet. In the event the name exceeds 31 characters, I would just stop at 31. So if a name in field 2 is 'abcdefghijklmnopqrstuvwxyz123456789' just go with 'abcdefghijklmnopqrstuvwxyz12345.'

[joeyc]

Norie,

This is good. I just need some code in there that can handle the invalid characters such as '/' and string lengths over 31. I would suggest either
(a) ignore the invalid characters and pulls the first 31 characters only
(b) if a name in column b contains some name that can't be used as a worksheet name just give those specific worksheets generic names like Sheet1, Sheet2, Sheet3, etc.

Right now, if a name has > 31 characters or an invalid character, the data doesn't transfer over. Big problem.

If I had code to overlook the invalid characters and merely give me the first 31 characters, I could do the manual work in those cases. I would prefer option (b) here. And this would be perfect.

Joeyc