Two Macros to One
Hi
I have a loop which works nicely but have it in two subs. Is there a way to get it into one without too much mess. It is really only one line which changes between the two as indicated in capitals in the second sub below. Thanks in Advance Chad Sub MoveMyStuff() Dim eRow As Long Dim i As Long Dim CpyRow As Long 'This code will move data based on a set of criteria. The criteria is the name in Col E and 'those clients who have a positive value in Col G. With Sheets("MYOB Dump") eRow = .Cells(Rows.Count, "E").End(xlUp).Row CpyRow = Sheets("Results").Cells(Rows.Count, "E").End(xlUp).Row + 1 For i = 11 To eRow 'starts in row 11 assuming headings in row 1-10 If .Cells(i, "E").Value = "LGA, Councils n Statutory Authorities" And _ .Cells(i, "G").Value = 0 Then .Rows(i).Copy Sheets("Results").Cells(CpyRow, 1) CpyRow = CpyRow + 1 End If Next i End With Call MoveMyStuffII End Sub Sub MoveMyStuffII() Dim eRow As Long Dim i As Long Dim CpyRow As Long With Sheets("MYOB Dump") eRow = .Cells(Rows.Count, "E").End(xlUp).Row CpyRow = Sheets("Results").Cells(Rows.Count, "E").End(xlUp).Row + 1 For i = 11 To eRow 'starts in row 11 assuming headings in row 1-10 ‘HERE SLIGHT VARIANCE IN THE SHEET TO GO TO. If .Cells(i, "E").Value = "Architects" And _ .Cells(i, "G").Value = 0 Then .Rows(i).Copy Sheets("Results").Cells(CpyRow, 1) CpyRow = CpyRow + 1 End If Next i End With End Sub |
Two Macros to One
Sub MoveMyStuff_R1() Dim eRow As Long Dim i As Long Dim CpyRow As Long Application.ScreenUpdating = False 'This code will move data based on a set of criteria. 'The criteria is the name in Col E and clients with a positive value in Col G. With Sheets("MYOB Dump") .DisplayPageBreaks = False eRow = .Cells(Rows.Count, "E").End(xlUp).Row CpyRow = Sheets("Results").Cells(Rows.Count, "E").End(xlUp).Row + 1 'Starts in row 11 assuming headings in Row 1 - 10 For i = 11 To eRow If (.Cells(i, "E").Value = "LGA, Councils n Statutory Authorities" Or _ .Cells(i, "E").Value = "Architects") And _ .Cells(i, "G").Value = 0 Then .Rows(i).Copy Sheets("Results").Cells(CpyRow, 1) CpyRow = CpyRow + 1 End If Next 'i End With Application.ScreenUpdating = True End Sub -- Jim Cone Portland, Oregon USA http://www.realezsites.com/bus/primitivesoftware (Excel Add-ins / Excel Programming) "Chad" wrote in message Hi I have a loop which works nicely but have it in two subs. Is there a way to get it into one without too much mess. It is really only one line which changes between the two as indicated in capitals in the second sub below. Thanks in Advance Chad Sub MoveMyStuff() Dim eRow As Long Dim i As Long Dim CpyRow As Long 'This code will move data based on a set of criteria. The criteria is the name in Col E and 'those clients who have a positive value in Col G. With Sheets("MYOB Dump") eRow = .Cells(Rows.Count, "E").End(xlUp).Row CpyRow = Sheets("Results").Cells(Rows.Count, "E").End(xlUp).Row + 1 For i = 11 To eRow 'starts in row 11 assuming headings in row 1-10 If .Cells(i, "E").Value = "LGA, Councils n Statutory Authorities" And _ .Cells(i, "G").Value = 0 Then .Rows(i).Copy Sheets("Results").Cells(CpyRow, 1) CpyRow = CpyRow + 1 End If Next i End With Call MoveMyStuffII End Sub Sub MoveMyStuffII() Dim eRow As Long Dim i As Long Dim CpyRow As Long With Sheets("MYOB Dump") eRow = .Cells(Rows.Count, "E").End(xlUp).Row CpyRow = Sheets("Results").Cells(Rows.Count, "E").End(xlUp).Row + 1 For i = 11 To eRow 'starts in row 11 assuming headings in row 1-10 ‘HERE SLIGHT VARIANCE IN THE SHEET TO GO TO. If .Cells(i, "E").Value = "Architects" And _ .Cells(i, "G").Value = 0 Then .Rows(i).Copy Sheets("Results").Cells(CpyRow, 1) CpyRow = CpyRow + 1 End If Next i End With End Sub |
Two Macros to One
Hi Jim
Sorry for the delay I was out of the office yesterday. I tried your code and it worked very well indeed. Thank you so much for your help it was very nice of you to take the time to reply. Have a good one Chad |
All times are GMT +1. The time now is 03:12 AM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com