Two Macros to One

[Chad]

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

 

[Jim Cone]

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

 

[Chad]

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