PDA

View Full Version : Simple VBA request



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

lucas
05-01-2006, 09:23 AM
1st question that comes to mind is:
are there other sheets in the book or just the 3?

JohnnyBravo
05-01-2006, 09:40 AM
1st question that comes to mind is:
are there other sheets in the book or just the 3?

There are 3 workbooks in total and only 1 worksheet contained in each of them. All 3 workbooks will be open at the time.

lucas
05-01-2006, 10:22 AM
These will get you started....will combine workbooks from a folder

http://vbaexpress.com/kb/getarticle.php?kb_id=829

http://vbaexpress.com/kb/getarticle.php?kb_id=773

http://vbaexpress.com/kb/getarticle.php?kb_id=221

will then combine worksheets in a workbook:

http://vbaexpress.com/kb/getarticle.php?kb_id=151

JohnnyBravo
05-01-2006, 10:25 AM
Ok thanks i'll try them out when I get a chance. What are your thoughts on the 2nd part of my question?

lucas
05-01-2006, 10:45 AM
be sure to select a cell in column b. this will get you started.

Sub DeleteTSRXN()
Dim test As Boolean, x As Long, lastrow As Long, col As Long
col = ActiveCell.Column
lastrow = Cells(65536, col).End(xlUp).Row
For x = lastrow To 1 Step -1
test = Cells(x, col).Text Like "TS-RXN"
If test = True Then Cells(x, col).EntireRow.Delete
Next
End Sub

JohnnyBravo
05-01-2006, 10:48 AM
Thanks Lucas, now if i want to search for both strings at the same time, would the following modified code work? Have i done it correctly?


Sub DeleteTSRXN()
Dim test As Boolean, x As Long, lastrow As Long, col As Long
col = ActiveCell.Column
lastrow = Cells(65536, col).End(xlUp).Row
For x = lastrow To 1 Step -1
test = Cells(x, col).Text Like "TS-RXN"
test = Cells(x, col).Text Like "BEX-RXN"
If test = True Then Cells(x, col).EntireRow.Delete
Next
End Sub

lucas
05-01-2006, 11:09 AM
Not quite, something like this:

Option Explicit
Sub DeleteTSRXN()
Dim test As Boolean, x As Long, lastrow As Long, col As Long
col = ActiveCell.Column
lastrow = Cells(65536, col).End(xlUp).Row
For x = lastrow To 1 Step -1
test = Cells(x, col).Text Like "TS-RXN"

If test = True Then Cells(x, col).EntireRow.Delete
Next

lastrow = Cells(65536, col).End(xlUp).Row
For x = lastrow To 1 Step -1

test = Cells(x, col).Text Like "BEX-RXN"
If test = True Then Cells(x, col).EntireRow.Delete
Next
End Sub

lucas
05-01-2006, 11:18 AM
this will automatically select column b. someone probably has a better idea but it works.

Sub DeleteTSRXNandBEXRXN()
Dim test As Boolean, x As Long, lastrow As Long, col As Long
Range("B8").Select
col = ActiveCell.Column
lastrow = Cells(65536, col).End(xlUp).Row
For x = lastrow To 1 Step -1
test = Cells(x, col).Text Like "TS-RXN"

If test = True Then Cells(x, col).EntireRow.Delete
Next

lastrow = Cells(65536, col).End(xlUp).Row
For x = lastrow To 1 Step -1

test = Cells(x, col).Text Like "BEX-RXN"
If test = True Then Cells(x, col).EntireRow.Delete
Next
End Sub

JohnnyBravo
05-01-2006, 11:20 AM
How do you make the routine search for any string that starts with that? In another words, i see that the code you wrote has to have the exact value "TS-RXN" and "BEX-RXN". In my spreadsheet, i have a whole bunch of letter & numbers that follow, so for example, TS-RXN 1k85K55AE. I don't care about the 2nd part, i just to target those that starts with TS-RXN... Hope that makes sense.

lucas
05-01-2006, 11:44 AM
Excellent entry by brettj, be sure to read the entry where it talks about partial strings and where to find it in the code.....
http://vbaexpress.com/kb/getarticle.php?kb_id=260

lucas
05-01-2006, 06:41 PM
Hi Johnny,
If you run into specific problems working on this be sure to post your questions here.