JohnnyBravo
05-01-2006, 08:41 AM
Probably a no brainer for the experts here, but I'm stumped.
I recorded the following macro but I need it tweaked. Basically, the task is to take the 3 worksheets and combine them into 1. But as you can see by the routine, it's dependent upon the fact that worksheet is always going to be the same. My problem is that the worksheet names will always vary. So how do you get VBA to combine 3 worksheets regardless of the worksheet name??
Secondly, in 2 out of those 3 worksheets, in Col. B, there are several cells with a string value that starts with TS-RXN or BEX-RXN. How do you tell VBA to identify those cells and delete that entire row? There's always more than 1. There's gotta be a better way than to record a macro for "Find & Replace" - right?
Sub Make_Report_Final()
'
'
' Macro recorded 4/28/2006 by John
'
Sheets("302520").Copy After:=Workbooks("302522.CSV").Sheets(1)
Sheets(Array("302520", "302522")).Select
Sheets("302520").Activate
Sheets(Array("302520", "302522")).Copy Before:=Workbooks("302523.CSV").Sheets( _
1)
Sheets(1).Select
Rows("1:9").Select
Range("A9").Activate
Selection.Delete Shift:=xlUp
Columns("B:B").Select
Selection.Cut
Columns("J:J").Select
Selection.Insert Shift:=xlToRight
Range("A:E,J:J,K:K,L:L,M:M").Select
Range("M1").Activate
ActiveWindow.SmallScroll ToRight:=11
Range("A:E,J:J,K:K,L:L,M:M,O:O,Q:Q,R:R,V:V,W:W,X:X").Select
Range("X1").Activate
Range("A:E,J:J,K:K,L:L,M:M,O:O,Q:Q,R:R,V:V,W:W,X:X,Z:Z,AA:AA,AB:AE").Select
Range("AB1").Activate
Selection.Delete Shift:=xlToLeft
Rows("1:1").Select
Selection.Replace What:="Resource", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Selection.Font.Bold = True
Range("A1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=12, Criteria1:="<0", Operator:=xlAnd
Sheets(2).Select
Rows("1:9").Select
Range("A9").Activate
Selection.Delete Shift:=xlUp
Columns("B:B").Select
Selection.Cut
Columns("J:J").Select
Selection.Insert Shift:=xlToRight
Range("A:E,J:J,K:K,L:L,M:M").Select
Range("M1").Activate
ActiveWindow.SmallScroll ToRight:=11
Range("A:E,J:J,K:K,L:L,M:M,O:O,Q:Q,R:R,V:V,W:W,X:X").Select
Range("X1").Activate
Range("A:E,J:J,K:K,L:L,M:M,O:O,Q:Q,R:R,V:V,W:W,X:X,Z:Z,AA:AA,AB:AE").Select
Range("AB1").Activate
Selection.Delete Shift:=xlToLeft
Rows("1:1").Select
Selection.Replace What:="Resource", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Selection.Font.Bold = True
Range("A1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=12, Criteria1:="<0", Operator:=xlAnd
Sheets(3).Select
Rows("1:9").Select
Range("A9").Activate
Selection.Delete Shift:=xlUp
Columns("B:B").Select
Selection.Cut
Columns("J:J").Select
Selection.Insert Shift:=xlToRight
Range("A:E,J:J,K:K,L:L,M:M").Select
Range("M1").Activate
ActiveWindow.SmallScroll ToRight:=11
Range("A:E,J:J,K:K,L:L,M:M,O:O,Q:Q,R:R,V:V,W:W,X:X").Select
Range("X1").Activate
Range("A:E,J:J,K:K,L:L,M:M,O:O,Q:Q,R:R,V:V,W:W,X:X,Z:Z,AA:AA,AB:AE").Select
Range("AB1").Activate
Selection.Delete Shift:=xlToLeft
Rows("1:1").Select
Selection.Replace What:="Resource", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Selection.Font.Bold = True
Range("A1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=12, Criteria1:="<0", Operator:=xlAnd
Range("A2").Select
ChDir "C:\Projects_JC\Time Sheets\Excel Download"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:= _
"C:\Projects_JC\Time Sheets\Excel Download\People Missing Time PAR.xls", _
FileFormat:=xlExcel9795
Application.DisplayAlerts = True
Worksheets.Add Count:=2, After:=Sheets(3)
Sheets(4).Select
Sheets(4).Name = "People that are DONE"
Sheets(5).Select
Sheets(5).Name = "Employees Missing Time"
Sheets("301126").Select
Sheets("301126").Move After:=Sheets(1)
Sheets(1).Select
Rows("1:1").Select
Selection.Copy
Sheets("People that are DONE").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("Employees Missing Time").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets(1).Select
Range("A1").Select
End Sub
I recorded the following macro but I need it tweaked. Basically, the task is to take the 3 worksheets and combine them into 1. But as you can see by the routine, it's dependent upon the fact that worksheet is always going to be the same. My problem is that the worksheet names will always vary. So how do you get VBA to combine 3 worksheets regardless of the worksheet name??
Secondly, in 2 out of those 3 worksheets, in Col. B, there are several cells with a string value that starts with TS-RXN or BEX-RXN. How do you tell VBA to identify those cells and delete that entire row? There's always more than 1. There's gotta be a better way than to record a macro for "Find & Replace" - right?
Sub Make_Report_Final()
'
'
' Macro recorded 4/28/2006 by John
'
Sheets("302520").Copy After:=Workbooks("302522.CSV").Sheets(1)
Sheets(Array("302520", "302522")).Select
Sheets("302520").Activate
Sheets(Array("302520", "302522")).Copy Before:=Workbooks("302523.CSV").Sheets( _
1)
Sheets(1).Select
Rows("1:9").Select
Range("A9").Activate
Selection.Delete Shift:=xlUp
Columns("B:B").Select
Selection.Cut
Columns("J:J").Select
Selection.Insert Shift:=xlToRight
Range("A:E,J:J,K:K,L:L,M:M").Select
Range("M1").Activate
ActiveWindow.SmallScroll ToRight:=11
Range("A:E,J:J,K:K,L:L,M:M,O:O,Q:Q,R:R,V:V,W:W,X:X").Select
Range("X1").Activate
Range("A:E,J:J,K:K,L:L,M:M,O:O,Q:Q,R:R,V:V,W:W,X:X,Z:Z,AA:AA,AB:AE").Select
Range("AB1").Activate
Selection.Delete Shift:=xlToLeft
Rows("1:1").Select
Selection.Replace What:="Resource", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Selection.Font.Bold = True
Range("A1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=12, Criteria1:="<0", Operator:=xlAnd
Sheets(2).Select
Rows("1:9").Select
Range("A9").Activate
Selection.Delete Shift:=xlUp
Columns("B:B").Select
Selection.Cut
Columns("J:J").Select
Selection.Insert Shift:=xlToRight
Range("A:E,J:J,K:K,L:L,M:M").Select
Range("M1").Activate
ActiveWindow.SmallScroll ToRight:=11
Range("A:E,J:J,K:K,L:L,M:M,O:O,Q:Q,R:R,V:V,W:W,X:X").Select
Range("X1").Activate
Range("A:E,J:J,K:K,L:L,M:M,O:O,Q:Q,R:R,V:V,W:W,X:X,Z:Z,AA:AA,AB:AE").Select
Range("AB1").Activate
Selection.Delete Shift:=xlToLeft
Rows("1:1").Select
Selection.Replace What:="Resource", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Selection.Font.Bold = True
Range("A1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=12, Criteria1:="<0", Operator:=xlAnd
Sheets(3).Select
Rows("1:9").Select
Range("A9").Activate
Selection.Delete Shift:=xlUp
Columns("B:B").Select
Selection.Cut
Columns("J:J").Select
Selection.Insert Shift:=xlToRight
Range("A:E,J:J,K:K,L:L,M:M").Select
Range("M1").Activate
ActiveWindow.SmallScroll ToRight:=11
Range("A:E,J:J,K:K,L:L,M:M,O:O,Q:Q,R:R,V:V,W:W,X:X").Select
Range("X1").Activate
Range("A:E,J:J,K:K,L:L,M:M,O:O,Q:Q,R:R,V:V,W:W,X:X,Z:Z,AA:AA,AB:AE").Select
Range("AB1").Activate
Selection.Delete Shift:=xlToLeft
Rows("1:1").Select
Selection.Replace What:="Resource", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Selection.Font.Bold = True
Range("A1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=12, Criteria1:="<0", Operator:=xlAnd
Range("A2").Select
ChDir "C:\Projects_JC\Time Sheets\Excel Download"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:= _
"C:\Projects_JC\Time Sheets\Excel Download\People Missing Time PAR.xls", _
FileFormat:=xlExcel9795
Application.DisplayAlerts = True
Worksheets.Add Count:=2, After:=Sheets(3)
Sheets(4).Select
Sheets(4).Name = "People that are DONE"
Sheets(5).Select
Sheets(5).Name = "Employees Missing Time"
Sheets("301126").Select
Sheets("301126").Move After:=Sheets(1)
Sheets(1).Select
Rows("1:1").Select
Selection.Copy
Sheets("People that are DONE").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("Employees Missing Time").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets(1).Select
Range("A1").Select
End Sub