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
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.