EXCEL 2003 Macro

Microsoft Office excel 2003
January 23, 2011 at 09:30:33
Specs: Windows XP
I have a report that needs to do the following:
insert a column in C
do a vlokoup from another workbook in C
sort entire workbook by those results in C
changed the name of the tab
add 7 new tabs each named
copy the header from first tab onto all new tabs
move any rows that have a specific number in column g to its corresponding tab
move each row that has a certian number in column c to its corresponding tab

CAN ANYONE HELP?! :-)


See More: EXCEL 2003 Macro

Report •

#1
January 23, 2011 at 20:13:13
We might be able to help, but not without more info.

insert a column in C

That's pretty clear.

do a vlokoup from another workbook in C

Another workbook or another worksheet?

sort entire workbook by those results in C

Entire workbook or entire worksheet?

changed the name of the tab

Changed or change?

Change to what?

add 7 new tabs each named

Each named what?

copy the header from first tab onto all new tabs

Do you really mean Header (as in Header/Footer) or do you mean the column labels from Row 1?

move any rows that have a specific number in column g to its corresponding tab

move each row that has a certian number in column c to its corresponding tab

How will we know which is the "corresponding tab"?

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#2
January 30, 2011 at 06:42:22

Thanks for getting back with me! I have managed to figure all the steps of the macros out except the very last part. The last part I need to sort the Originals by column G then copy all rows with a 590 in column G to the Banko tab, all rows with 321 in column G copy and paste to the Closed tab, and then sort the tab by column C and copy all rows that have Discover in column C to the discover tab.
Here is a sample of the spreadsheet:

OFILE FWD CLIENT DATE REC TOT PAID BALANCE ST1
123 1551 RES 2/10/2011 $5,000.00 0 321
741 1557 BOA 2/12/2011 $7,000.00 0 590
369 1641 DISCOVER 2/13/2011 $8,000.00


Report •

#3
January 30, 2011 at 07:43:30
Two suggestions:

1 - Please read the How To referenced in my signature line. It will provide instructions on the proper way to post both data and VBA code so that they are easier to read in this forum.

2 - Since you already have a "partial macro" written, please post it. Since we don't know what you wrote, it's hard for us to suggest how to add "the very last part".

DerbyDad03
Office Forum Moderator

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

Related Solutions

#4
January 30, 2011 at 08:13:18
OFILE	FWD	CLIENT	DATE REC TOT PAID   BALANCE    ST1
123	1551	RES 	2/10/90	 $10,000.00 	0	321
741	1557	BOA	2/10/91	 $20,000.00 	0	590
369	1641	DISCOVER 2/10/92 $8,000.00 	0	

Sub BOA_S_CODING_MACRO()
'
' BOA_S_CODING_MACRO Macro
' Macro recorded 1/21/2011 by 39001ram
'

'
    ChDir _
        "Q:\Roswell Rd Admin\S-CODING"
    Workbooks.Open Filename:= _
        "Q:\Roswell Rd Admin\S-CODING\CLIENT FORWARDER LIST.XLS"
    Windows("CLSEXCEL.XLS").Activate
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight
    Range("C2").Select
    ChDir "Q:\Roswell Rd Admin\S-CODING"
    Workbooks.Open Filename:= _
        "Q:\Roswell Rd Admin\S-CODING\CLIENT FORWARDER LIST.xls"
    Windows("CLSEXCEL.XLS").Activate
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(C[-1],'[CLIENT FORWARDER LIST.xls]Sheet1'!C1:C2,2,FALSE)"
    Selection.AutoFill Destination:=Range("C2:C2000")
    Columns("C:C").Select
    Selection.COPY
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select
    Range("C2:C73").Select
    Cells.Select
    Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "CLIENT"
    With ActiveCell.Characters(Start:=1, Length:=6).Font
        .Name = "TimesNewRoman"
        .FontStyle = "Regular"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("D6").Select
    ActiveWindow.SmallScroll Down:=-30
    Windows("CLIENT FORWARDER LIST.xls").Activate
    ActiveWindow.Close
    Sheets.Add
    Sheets("Sheet1").Select
    Sheets("Sheet1").Move After:=Sheets(2)
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "BOA"
    Range("B47").Select
    Sheets.Add
    Sheets("Sheet2").Select
    Sheets("Sheet2").Move After:=Sheets(3)
    Sheets("Sheet2").Select
    Sheets("Sheet2").Name = "DISCOVER"
    Range("C46").Select
    Sheets.Add
    Sheets("Sheet3").Select
    Sheets("Sheet3").Move After:=Sheets(4)
    Sheets("Sheet3").Select
    Sheets("Sheet3").Name = "RESURGENT"
    Range("D46").Select
    Sheets.Add
    Sheets("Sheet4").Select
    Sheets("Sheet4").Move After:=Sheets(5)
    Sheets("Sheet4").Select
    Sheets("Sheet4").Name = "NAN"
    Range("F47").Select
    Sheets.Add
    Range("F49:F51").Select
    Sheets("Sheet5").Select
    Sheets("Sheet5").Name = "MIDLAND"
    Range("F51").Select
    Sheets.Add
    Sheets("Sheet6").Select
    Sheets("Sheet6").Move After:=Sheets(7)
    Sheets("Sheet6").Select
    Sheets("Sheet6").Name = "PAAM"
    Range("G48").Select
    Sheets.Add
    Sheets("Sheet7").Select
    Sheets("Sheet7").Name = "FAAM"
    Sheets("RESURGENT").Select
    Range("B49").Select
    Sheets("CLSEXCEL").Select
    Rows("1:1").Select
    Selection.COPY
    Sheets("BOA").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("DISCOVER").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("RESURGENT").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("MIDLAND").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("NAN").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("FAAM").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("PAAM").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("CLSEXCEL").Select
    Sheets("CLSEXCEL").Name = "ORIGINAL"
    Range("A1").Select
    Sheets.Add
    Sheets("Sheet8").Select
    Sheets("Sheet8").Name = "CLOSED"
    Sheets("ORIGINAL").Select
    Rows("1:1").Select
    Selection.COPY
    Sheets("CLOSED").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("ORIGINAL").Select
    Sheets("CLOSED").Select
    Sheets("CLOSED").Move After:=Sheets(9)
    Sheets("ORIGINAL").Select
    Range("A1").Select
    Application.CutCopyMode = False
    ActiveWindow.SmallScroll Down:=-36
    ChDir "Q:\Roswell Rd Admin\S-CODING"
    ActiveWorkbook.SaveAs Filename:= _
        "Q:\Roswell Rd Admin\S-CODING\MM.DD.YY S_CODING.XLS", FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
End Sub


Report •

#5
January 30, 2011 at 10:34:44
I have attempted to figure out what you code is doing, but there's is so much extra code that I'm am lost.

It's obvious that the code was recorded, but after using the recorder, you should go back into the code and clean it up.

Let's start the fact that rarely do you have to Select an object in VBA in order to perform an operation on it. Selecting cells, ranges, sheets etc. not only slows the code down considerably, but also make the code very hard to follow.

Here are a few examples that you should deal with. There is so much of this type of "wasted" code.

======================

    Range("A1").Select
      Range("C2:C73").Select
       Cells.Select
         Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("C1").Select

Here's what this section of code does:

Range("A1").Select

This selects A1 (for no apparent reason)

Range("C2:C73").Select

This selects C2:C73 (for no apparent reason)

Cells.Select

This selects all of the cells in the sheet (I assume so that the code can sort them)

Selection.Sort Key1:=Range("C2"),
    Order1:=xlAscending, Header:=xlYes, _
    OrderCustom:=1, MatchCase:=False, _
    Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal

This sorts the selected cells.

Range("C1").Select

This selects C1 (for no apparent reason)

Those 5 lines of code can be reduced to 1:

Cells.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

======================

Every place that you are moving and renaming sheets, you use 4 lines that look like this:

    
    Sheets("Sheet2").Select
    Sheets("Sheet2").Move After:=Sheets(3)
    Sheets("Sheet2").Select
    Sheets("Sheet2").Name = "DISCOVER"

Every one of those 4 line sections can be reduced to 2 lines:

    
   Sheets("Sheet2").Move After:=Sheets(3)
   Sheets("Sheet2").Name = "DISCOVER"

======================

Look throughout your code for bloat like this:

Sheets("ORIGINAL").Select
    Sheets("CLOSED").Select
    Sheets("CLOSED").Move After:=Sheets(9)
    Sheets("ORIGINAL").Select

Your code is selecting sheets for no reason. The only line that actually does anything is the line that Moves the sheet named "Closed". This rest of those lines are just wasting resources.

There are lots of other lines of code where it appears that you just clicked randomly in a sheet and the recorder recorded it.

Look around in your code and find the lines where you are selecting objects (sheets and cells) and then not doing anything with them. Delete those lines.

======================

Finally (at least for now) the entire section where you are copying Rows("1:1") to all the other sheets can be reduced to a Loop.

In the section where you are using this repetitive code:

Sheets("CLSEXCEL").Select
    Rows("1:1").Select
    Selection.COPY
    Sheets("BOA").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("DISCOVER").Select
    Range("A1").Select
    ActiveSheet.Paste
    etc. etc. etc

Instead, try this loop. Obviously you'll need to add all of the other Sheet names to the Array.

  Set Source = Sheets("CLSEXCEL").Rows("1:1")
    shtArray = Array("BOA", "DISCOVER", "RESURGENT", etc.)
    shtCount = UBound(shtArray)
     
    For s = 0 To shtCount
        Set Dest = Sheets(shtArray(s)).Range("A1")
        Source.Copy Destination:=Dest
    Next s

Do me a favor and clean up your code so that I can follow it and then we'll see if we can suggest something for the part you are missing.

If you put your cursor anywhere in your code, you can press F8 to Single step through your code. With the VBA editor sized so that you can see your workbook also, you can watch what the code is doing and eliminate all the steps that don't actually do anything useful.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#6
January 30, 2011 at 11:12:27
I am new to creating macros- my first one. I think I made all the changes you requested. Please let me know what else I need to correct, if any.
THANK SO MUCH FOR YOUR HELP!

 ChDir _
        "Q:\Roswell Rd Admin\S-CODING"
    Workbooks.Open Filename:= _
        "Q:\Roswell Rd Admin\S-CODING\CLIENT FORWARDER LIST.XLS"
    Windows("CLSEXCEL.XLS").Activate
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight
    Range("C2").Select
    ChDir "Q:\Roswell Rd Admin\S-CODING"
    Workbooks.Open Filename:= _
        "Q:\Roswell Rd Admin\S-CODING\CLIENT FORWARDER LIST.xls"
    Windows("CLSEXCEL.XLS").Activate
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(C[-1],'[CLIENT FORWARDER LIST.xls]Sheet1'!C1:C2,2,FALSE)"
    Selection.AutoFill Destination:=Range("C2:C2000")
    Columns("C:C").Select
    Selection.COPY
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Cells.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    ActiveCell.FormulaR1C1 = "CLIENT"
    With ActiveCell.Characters(Start:=1, Length:=6).Font
        .Name = "TimesNewRoman"
        .FontStyle = "Regular"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("D6").Select
    ActiveWindow.SmallScroll Down:=-30
    Windows("CLIENT FORWARDER LIST.xls").Activate
    ActiveWindow.Close
    Sheets("Sheet1").Name = "ORIGINAL"
    Sheets.Add
    Sheets("Sheet2").Move After:=Sheets(1)
    Sheets("Sheet2").Name = "DISCOVER"
    Sheets("Sheet3").Move After:=Sheets(2)
    Sheets("Sheet3").Name = "BOA"
    Sheets("Sheet4").Move After:=Sheets(3)
    Sheets("Sheet4").Name = "Resurgent"
    Sheets("Sheet5").Move After:=Sheets(4)
    Sheets("Sheet5").Name = "NAN CAP ONE"
    Sheets("Sheet6").Move After:=Sheets(5)
    Sheets("Sheet6").Name = "PAAM"  
    Sheets("Sheet7").Move After:=Sheets(6)
    Sheets("Sheet7").Name = "FAAM"
    Sheets("Sheet8").Move After:=Sheets(7)
    Sheets("Sheet8").Name = "BANKO"
    Sheets("Sheet9").Move After:=Sheets(8)
    Sheets("Sheet9").Name = "CLOSED"
    Set Source = Sheets("CLSEXCEL").Rows("1:1")
    shtArray = Array("BOA", "DISCOVER", "RESURGENT", "NAN CAP ONE", "PAAM", "FAAM", "BANKO", "CLOSED")
    shtCount = UBound(shtArray)
     
    For s = 0 To shtCount
        Set Dest = Sheets(shtArray(s)).Range("A1")
        Source.Copy Destination:=Dest
    Next s
    ChDir "Q:\Roswell Rd Admin\S-CODING"
    ActiveWorkbook.SaveAs Filename:= _
        "Q:\Roswell Rd Admin\S-CODING\MM.DD.YY S_CODING.XLS", FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
End Sub


Report •

#7
January 30, 2011 at 12:33:38
Did you test the new version of your code to make sure it does the same thing as you old version?

The main reason I ask is that in your old version had quite a few "Sheets.Add" lines but I only see one in your new version.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#8
January 30, 2011 at 15:17:30
I forgot to add that in. I am not able to test this until tomorrow.

<PRE>ChDir _
        "Q:\Roswell Rd Admin\S-CODING"
    Workbooks.Open Filename:= _
        "Q:\Roswell Rd Admin\S-CODING\CLIENT FORWARDER LIST.XLS"
    Windows("CLSEXCEL.XLS").Activate
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight
    Range("C2").Select
    ChDir "Q:\Roswell Rd Admin\S-CODING"
    Workbooks.Open Filename:= _
        "Q:\Roswell Rd Admin\S-CODING\CLIENT FORWARDER LIST.xls"
    Windows("CLSEXCEL.XLS").Activate
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(C[-1],'[CLIENT FORWARDER LIST.xls]Sheet1'!C1:C2,2,FALSE)"
    Selection.AutoFill Destination:=Range("C2:C2000")
    Columns("C:C").Select
    Selection.COPY
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Cells.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    ActiveCell.FormulaR1C1 = "CLIENT"
    With ActiveCell.Characters(Start:=1, Length:=6).Font
        .Name = "TimesNewRoman"
        .FontStyle = "Regular"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("D6").Select
    ActiveWindow.SmallScroll Down:=-30
    Windows("CLIENT FORWARDER LIST.xls").Activate
    ActiveWindow.Close
    Sheets("Sheet1").Name = "ORIGINAL"
    Sheets.Add
    Sheets("Sheet2").Move After:=Sheets(1)
    Sheets("Sheet2").Name = "DISCOVER"
    Sheets.Add 
    Sheets("Sheet3").Move After:=Sheets(2)
    Sheets("Sheet3").Name = "BOA"
    Sheets.Add
    Sheets("Sheet4").Move After:=Sheets(3)
    Sheets("Sheet4").Name = "Resurgent"
    Sheets.Add
    Sheets("Sheet5").Move After:=Sheets(4)
    Sheets("Sheet5").Name = "NAN CAP ONE"
    Sheets.Add 
    Sheets("Sheet6").Move After:=Sheets(5)
    Sheets("Sheet6").Name = "PAAM"  
Sheets.Add    
Sheets("Sheet7").Move After:=Sheets(6)
    Sheets("Sheet7").Name = "FAAM"
Sheets.Add    
Sheets("Sheet8").Move After:=Sheets(7)
    Sheets("Sheet8").Name = "BANKO"
    Sheets.Add
    Sheets("Sheet9").Move After:=Sheets(8)
    Sheets("Sheet9").Name = "CLOSED"
    Set Source = Sheets("CLSEXCEL").Rows("1:1")
    shtArray = Array("BOA", "DISCOVER", "RESURGENT", "NAN CAP ONE", "PAAM", "FAAM", "BANKO", "CLOSED")
    shtCount = UBound(shtArray)
     
    For s = 0 To shtCount
        Set Dest = Sheets(shtArray(s)).Range("A1")
        Source.Copy Destination:=Dest
    Next s
    ChDir "Q:\Roswell Rd Admin\S-CODING"
    ActiveWorkbook.SaveAs Filename:= _
        "Q:\Roswell Rd Admin\S-CODING\MM.DD.YY S_CODING.XLS", FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
End Sub



Report •

#9
January 31, 2011 at 04:56:45
Let me know if it still works. I don't want to waste time modifying code that doesn't at least do what it used to do.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#10
February 3, 2011 at 16:11:46
This marco works.
ChDir _
    "Q:\Roswell Rd Admin\S-CODING"
    Workbooks.Open Filename:= _
        "Q:\Roswell Rd Admin\S-CODING\CLIENT FORWARDER LIST.XLS"
    Windows("CLSEXCEL.XLS").Activate
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight
    Range("C2").Select
    ChDir "Q:\Roswell Rd Admin\S-CODING"
    Workbooks.Open Filename:= _
        "Q:\Roswell Rd Admin\S-CODING\CLIENT FORWARDER LIST.xls"
    Windows("CLSEXCEL.XLS").Activate
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(C[-1],'[CLIENT FORWARDER LIST.xls]Sheet1'!C1:C2,2,FALSE)"
    Selection.AutoFill Destination:=Range("C2:C2000")
    Columns("C:C").Select
    Selection.COPY
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Cells.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    ActiveCell.FormulaR1C1 = "CLIENT"
    With ActiveCell.Characters(Start:=1, Length:=6).Font
        .Name = "TimesNewRoman"
        .FontStyle = "Regular"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("D6").Select
    ActiveWindow.SmallScroll Down:=-30
    Windows("CLIENT FORWARDER LIST.xls").Activate
    ActiveWindow.Close
    Sheets("CLSEXCEL").Name = "ORIGINAL"
    Sheets.Add
    Sheets("Sheet1").Name = "BOA"
    Sheets.Add
    Sheets("Sheet2").Name = "DISCOVER"
    Sheets.Add
    Sheets("Sheet3").Name = "Resurgent"
    Sheets.Add
    Sheets("Sheet4").Name = "NAN CAP ONE"
    Sheets.Add
    Sheets("Sheet5").Name = "PAAM"
    Sheets.Add
    Sheets("Sheet6").Name = "FAAM"
    Sheets.Add
    Sheets("Sheet7").Name = "BANKO"
    Sheets.Add
    Sheets("Sheet8").Name = "CLOSED"
    Set Source = Sheets("ORIGINAL").Rows("1:1")
    shtArray = Array("BOA", "DISCOVER", "RESURGENT", "NAN CAP ONE", "PAAM", "FAAM", "BANKO", "CLOSED")
    shtCount = UBound(shtArray)
    Sheets("BOA").Select
    Sheets("BOA").Move After:=Sheets(9)
    Sheets("DISCOVER").Select
    Sheets("DISCOVER").Move After:=Sheets(9)
    Sheets("FAAM").Select
    Sheets("FAAM").Move After:=Sheets(9)
    Sheets("NAN CAP ONE").Select
    Sheets("NAN CAP ONE").Move After:=Sheets(9)
    Sheets("PAAM").Select
    Sheets("PAAM").Move After:=Sheets(9)
    Sheets("Resurgent").Select
    Sheets("Resurgent").Move After:=Sheets(9)
    Sheets("CLOSED").Select
    Sheets("CLOSED").Move After:=Sheets(9)
    Sheets("BANKO").Select
    Sheets("BANKO").Move After:=Sheets(9)
    Sheets("BANKO").Select
    ActiveWorkbook.Sheets("BANKO").Tab.ColorIndex = 3
    Sheets("CLOSED").Select
    ActiveWorkbook.Sheets("CLOSED").Tab.ColorIndex = 45
    Sheets("ORIGINAL").Select
    
    For s = 0 To shtCount
        Set Dest = Sheets(shtArray(s)).Range("A1")
        Source.COPY Destination:=Dest
    Next s
    ChDir "Q:\Roswell Rd Admin\S-CODING"
    ActiveWorkbook.SaveAs Filename:= _
        "Q:\Roswell Rd Admin\S-CODING\MM.DD.YY S_CODING.XLS", FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
End Sub
 


Report •

#11
February 13, 2011 at 10:49:44
I just need to figure out how to copy any rows that have a specific number in column G to its corresponding tab and also copy each row that has a certian number in column C to its corresponding tab.
For example, all rows that have 590 in column G need to go to the banko tab and all rows that have BA in coulmn C need to go to the BOA tab

Here a an example to the information:

FILE	FWD	CLIENT	DATE	   REC	            BALANCE	  STAT1
1234	1551	RES	1/1/2011	1	 $4,000.00 	590
5678	1557	BA	1/2/2011	2	 $8,000.00 	298
9876	1980	DISC	1/3/2011	3	 $12,000.00 	590

Is this possible?
Thanks!


Report •

#12
February 13, 2011 at 13:23:10
Replace SourceSheetName with the name of your source sheet. It's in three spots in the code.

Sub CopyRows()
'Determine last Row in Source Sheet
 last_srcRw = Sheets("SourceSheetName").Range("A" & Rows.Count).End(xlUp).Row
'Loop through Source Sheet
  For srcRw = 2 To last_srcRw
'Copy rows with BA in Column C to BOA
   If Sheets(1).Range("C" & srcRw) = "BA" Then
     nxt_dstRw = Sheets("BOA").Range("C" & Rows.Count).End(xlUp).Row + 1
     Sheets("SourceSheetName").Range("A" & srcRw).EntireRow.Copy _
        Destination:=Sheets("BOA").Range("A" & nxt_dstRw)
   End If
'Copy rows with 590 in Column G to banko
   If Sheets(1).Range("G" & srcRw) = "590" Then
     nxt_dstRw = Sheets("banko").Range("A" & Rows.Count).End(xlUp).Row + 1
     Sheets("SourceSheetName").Range("A" & srcRw).EntireRow.Copy _
        Destination:=Sheets("banko").Range("A" & nxt_dstRw)
   End If
  Next
End Sub

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

Ask Question