Macro for filtering/copying/and pasting to new tabs

K

kamehameha1

New member
Joined
Feb 19, 2019
Messages
1
Reaction score
0
Points
0
Excel Version(s)
2013
Hi there, below is the code I have in the excel file. Basically what it does it starts with one tab full of data, creates 3 new tabs, and then filter/copy/paste information from the original data set to each of the 3 new tabs based upon different attributes. It also adds a new "date" column to the original data set.

I am pretty new to VBA and made this macro with mostly online searches and the record function. I'm curious to see if there are more advanced ways write this code so the file runs faster, doesn't take up as much space, and doesn't constantly crash


Thank you!




Code: 
[COLOR=#333333]Public Sub sing_off_formatting()
[/COLOR]Selection.CurrentRegion.Select
Selection.Columns.AutoFit
Selection.Rows.AutoFit

'Creates tabs for each of the desired reports
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Prepared Screens"
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Senior Reviewed"
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Manager Reviewed"

'Creates a column that only has a date for reference
Sheets("sing off analysis macro").Activate
Columns("O:O").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("O1").Select
ActiveCell.FormulaR1C1 = "Prepared Date"
Range("O2").Select
ActiveCell.FormulaR1C1 = "=RIGHT(RC[1],9)"
Range("O2").Select
Selection.AutoFill Destination:=Range("O2:O999")
Columns("O:O").Select
Selection.NumberFormat = "m/d/yyyy"

'Creates report with screens that are prepared and not reviewed and highlights screens prepared last month
Sheets("sing off analysis macro").Activate
Sheets("sing off analysis macro").Cells.Select
ActiveSheet.Range("$A$1:$U$352").AutoFilter Field:=3, Criteria1:="Prepared"
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("Prepared Screens").Activate
ActiveSheet.Paste
Selection.Columns.AutoFit
Selection.Rows.AutoFit


'creates report with screens that are reviewed by only the senior and highlights screens prepared last month
Sheets("sing off analysis macro").Activate
Range("C1").Select
ActiveSheet.ShowAllData
ActiveSheet.Range("$A$1:$T$352").AutoFilter Field:=13, Criteria1:= _
"XXXXXXX, Timothy"
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("Senior Reviewed").Activate
ActiveSheet.Paste
Selection.Columns.AutoFit
Selection.Rows.AutoFit
Range("E1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$T$7").AutoFilter Field:=7, Criteria1:="="

'creates report with screens that are reviewed by only the manager and highlights screens prepared last month
Sheets("sing off analysis macro").Activate
Range("C1").Select
ActiveSheet.ShowAllData
ActiveSheet.Range("$A$1:$T$352").AutoFilter Field:=13, Criteria1:= _
"XXXXX, Scott"
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("Manager Reviewed").Activate
ActiveSheet.Paste
Selection.Columns.AutoFit
Selection.Rows.AutoFit
Range("E1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$T$7").AutoFilter Field:=5, Criteria1:="="

End Sub
 
Last edited by a moderator:
try:
Code: 
Public Sub sing_off_formatting()
'Creates tabs for sing off analysis macroeach of the desired reports
Set PS = Sheets.Add(After:=Sheets(Sheets.Count))
PS.Name = "Prepared Screens"
Set SR = Sheets.Add(After:=Sheets(Sheets.Count))
SR.Name = "Senior Reviewed"
Set MR = Sheets.Add(After:=Sheets(Sheets.Count))
MR.Name = "Manager Reviewed"

With Sheets("sing off analysis macro")
  .UsedRange.Columns.AutoFit
  .UsedRange.Rows.AutoFit

  'Creates a column that only has a date for reference
  .Columns("O:O").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
  .Range("O1").Value = "Prepared Date"
  .Range("O2:O999").FormulaR1C1 = "=RIGHT(RC[1],9)"
  .Columns("O").NumberFormat = "m/d/yyyy"

  'Creates report with screens that are prepared and not reviewed and highlights screens prepared last month
  With .Range("$A$1:$U$352")
    .AutoFilter Field:=3, Criteria1:="Prepared"
    .SpecialCells(xlCellTypeVisible).Copy PS.Range("A1")
  End With

  'creates report with screens that are reviewed by only the senior and highlights screens prepared last month
  .ShowAllData
  With .Range("$A$1:$T$352")
    .AutoFilter Field:=13, Criteria1:="XXXXXXX, Timothy"
    .SpecialCells(xlCellTypeVisible).Copy SR.Range("A1")
  End With

  'creates report with screens that are reviewed by only the manager and highlights screens prepared last month
  .ShowAllData
  With .Range("$A$1:$T$352")
    .AutoFilter Field:=13, Criteria1:="XXXXX, Scott"
    .SpecialCells(xlCellTypeVisible).Copy MR.Range("A1")
  End With
End With    'Sheets("sing off analysis macro")
PS.UsedRange.Columns.AutoFit
PS.UsedRange.Rows.AutoFit
SR.UsedRange.Columns.AutoFit
SR.UsedRange.Rows.AutoFit
SR.Range("$A$1:$T$7").AutoFilter Field:=7, Criteria1:="="
MR.UsedRange.Columns.AutoFit
MR.UsedRange.Rows.AutoFit
MR.Range("$A$1").CurrentRegion.AutoFilter Field:=5, Criteria1:="="
End Sub
But there are still some bits which could be more robust - I've used your hard coded ranges and .UsedRange a bit too often. To make it more robust it would be better for me to see a workbook.
 
@kame
Hi,
When posting code, please wrap it with code tags ( Edit code - select code - click the #button.)
It keeps the macro's structure and makes it easy to copy and handle.
Thank you

I did it for you this time
 
hmmm, I wonder if I'll feel like helping kamehameha1 again?
 
You must log in or register to reply here.
Back
Top