PDA

View Full Version : [SOLVED] loop thru every sheet and filter out a specific name and create a new sheet



austenr
06-20-2019, 06:57 AM
Looking for a way to loop thru every sheet in a WB and filter all the rows with a certain name and make a new sheet for them. I can do it for one but if the name appears on multiple sheets i need to append to the sheet already created.

So if you have "Mike" on sheet one create a sheet called Mike, copy the rows from the original sheet to a sheet called Mike and then look in the other sheets for that name. If it exists in another sheet copy those rows and append to the sheet you created called Mike.

I need to do this with multiple people the same way. A small sample workbook attached.

Paul_Hossler
06-20-2019, 08:35 AM
If the final order of the data on each User is not important




Option Explicit
Sub MergeSortSchred()
Dim wsTemp As Worksheet, ws As Worksheet, wsName As Worksheet
Dim rDest As Range, rSrc As Range, rSort As Range, rRow As Range
Dim sPrevName As String

Application.ScreenUpdating = False

'add new temp
Set wsTemp = pvtAddSheet("Temp")


'merge all worksheets onto temp
For Each ws In ActiveWorkbook.Worksheets

Set rDest = wsTemp.Cells(wsTemp.Rows.Count, 1).End(xlUp)
If Not ws Is wsTemp Then
Set rSrc = ws.UsedRange
Set rSrc = Intersect(rSrc, Range(ws.Rows(2), ws.Rows(Rows.Count)))
Set rDest = wsTemp.Cells(wsTemp.Rows.Count, 1).End(xlUp).Offset(1, 0)
rSrc.Copy rDest
End If
Next


'sort temp by Balance in column 1 first
Set rSort = wsTemp.Cells(1, 1)
Set rSort = Range(rSort, wsTemp.Cells(wsTemp.Rows.Count, 1).End(xlUp))
Set rSort = Intersect(rSort.EntireRow, wsTemp.UsedRange.EntireColumn)

With wsTemp.Sort
.SortFields.Clear
.SortFields.Add Key:=rSort.Columns(1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange rSort
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With


'sort temp by name in column 2
Set rSort = wsTemp.Cells(1, 1)
Set rSort = Range(rSort, wsTemp.Cells(wsTemp.Rows.Count, 1).End(xlUp))
Set rSort = Intersect(rSort.EntireRow, wsTemp.UsedRange.EntireColumn)
With wsTemp.Sort
.SortFields.Clear
.SortFields.Add Key:=rSort.Columns(2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange rSort
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

'loop down wsTemp, add sheet for new name, copy data over
sPrevName = vbNullString

For Each rRow In wsTemp.Cells(1, 1).CurrentRegion.Rows
With rRow
'some names in sampe are blank
If Len(.Cells(2).Value) = 0 Then .Cells(2).Value = "No Name"

If .Cells(2).Value <> sPrevName Then
sPrevName = .Cells(2).Value
Set wsName = pvtAddSheet(.Cells(2).Value)
wsName.Cells(1, 1).Value = "Balance"
wsName.Cells(1, 2).Value = "User"
End If

.Copy wsName.Cells(wsName.Rows.Count, 1).End(xlUp).Offset(1, 0)
End With
Next


Call pvtDeleteSheet("Temp")

Application.ScreenUpdating = True

MsgBox "Done"

End Sub

Private Sub pvtDeleteSheet(s As String)
On Error Resume Next
Application.DisplayAlerts = False
Worksheets(s).Delete
Application.DisplayAlerts = True
On Error GoTo 0
End Sub

Private Function pvtAddSheet(s As String) As Worksheet

Call pvtDeleteSheet(s)

Worksheets.Add.Name = s
Set pvtAddSheet = ActiveSheet
End Function

austenr
06-20-2019, 08:54 AM
Hi Paul. Thanks for that. Exactly what I need with a slight tweek. What all do I have to change the sort column to column M (13)?

austenr
06-20-2019, 09:31 AM
Ive attached a sample of one line of the master sheet. The name is in Column M (13) I see you are also sorting by amount which would be col J. The page also has headers. The rest is exactly what I wanted. Thanks.

Paul_Hossler
06-20-2019, 01:37 PM
not tested, but you should just need to change the corresponding lines

it's .Header = xlNo because when I build Temp, I skip the headers on the input sheets so Temp has no headers

I sort by amount first since there are missing names



'sort temp by balance in column 10 first
Set rSort = wsTemp.Cells(1, 1)
Set rSort = Range(rSort, wsTemp.Cells(wsTemp.Rows.Count, 1).End(xlUp))
Set rSort = Intersect(rSort.EntireRow, wsTemp.UsedRange.EntireColumn)

With wsTemp.Sort
.SortFields.Clear
.SortFields.Add Key:=rSort.Columns(10), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange rSort
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With


'sort temp by name in column 13
Set rSort = wsTemp.Cells(1, 1)
Set rSort = Range(rSort, wsTemp.Cells(wsTemp.Rows.Count, 1).End(xlUp))
Set rSort = Intersect(rSort.EntireRow, wsTemp.UsedRange.EntireColumn)
With wsTemp.Sort
.SortFields.Clear
.SortFields.Add Key:=rSort.Columns(13), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange rSort
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

austenr
06-20-2019, 03:43 PM
Hi Paul. Thanks. Trying to run this in Excel 2007. When you run it you get the following on


rSrc.Copy rDest in the


'merge all worksheets onto temp For Each ws In ActiveWorkbook.Worksheets

Set rDest = wsTemp.Cells(wsTemp.Rows.Count, 1).End(xlUp)
If Not ws Is wsTemp Then
Set rSrc = ws.UsedRange
Set rSrc = Intersect(rSrc, Range(ws.Rows(2), ws.Rows(Rows.Count)))
Set rDest = wsTemp.Cells(wsTemp.Rows.Count, 1).End(xlUp).Offset(1, 0)
rSrc.Copy rDest
End If
Next


getting the error: object variable or with block variable no set. error

Paul_Hossler
06-20-2019, 05:10 PM
probably data dependant

Make and post a WB with 1 or 2 sheets that shows the issue

austenr
06-20-2019, 05:15 PM
here you are

Paul_Hossler
06-21-2019, 06:44 AM
Sorry, I thought I posted this last night -- must not have

1. It was the Rules sheet since it was in a format not compatible with the macro, which assumed only data like in the first sample
I added a check for "Program Name" in A1

2. Caught some places that still referenced the columns in the first sampe (1 and 2) instead of 10 and 13

3. Added some formatting, status messages, and some cleanup

austenr
06-21-2019, 09:20 AM
thanks Paul. Thats awesome. Solved