Merging Two Codes Into one code
 

Hi everybody,

I have these two codes:

The first one works on selecting specific records whose values are mor
than zero, and the other one is working on copying the selected record
by the first code to another sheet.

I tried to merge them in one code to get the same purpose but I foun
the second code move all records even those who have 0 value records
so I would like you please to help me in this matter.

First Code:

Code
-------------------
Sub Highlight ()
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long

With ActiveSheet
FirstRow = 7
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = FirstRow To LastRow
If .Cells(iRow, "A").Value 0 Then
If myRng Is Nothing Then
Set myRng = .Cells(iRow, "A")
Else
Set myRng = Union(.Cells(iRow, "A"), myRng)
End If
End If
Next iRow

If myRng Is Nothing Then
MsgBox "No records to select"
Else
Intersect(myRng.EntireRow, .Range("a:j")).Select
End If
End With

End Su
-------------------

Second Code:

Code
-------------------
Sub Copy_Move()
Dim srcRng As Range
Dim destRng As Range
Dim Lrow As Long
Lrow = Cells(Rows.Count, "A").End(xlUp).Row
Set srcRng = ActiveSheet.Range("A7:J" & Lrow)
Set destRng = Sheets("100"). _
Cells(Rows.Count, "A").End(xlUp)(2)
srcRng.Copy Destination:=destRng
MsgBox "Data moved to the other sheet successfully", vbInformation, "Done"
End Su
-------------------

--
LoveCandl
-----------------------------------------------------------------------
LoveCandle's Profile: http://www.excelforum.com/member.php...fo&userid=2861
View this thread: http://www.excelforum.com/showthread.php?threadid=48772

Merging Two Codes Into one code
 

Maybe...

Option Explicit
Sub Highlight()
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim myRng As Range

Dim srcRng As Range
Dim destRng As Range

With ActiveSheet
FirstRow = 7
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = FirstRow To LastRow
If .Cells(iRow, "A").Value 0 Then
If myRng Is Nothing Then
Set myRng = .Cells(iRow, "A")
Else
Set myRng = Union(.Cells(iRow, "A"), myRng)
End If
End If
Next iRow

If myRng Is Nothing Then
MsgBox "No records to select"
Else
Set srcRng = Intersect(myRng.EntireRow, .Range("a:j"))
With Worksheets("100")
Set destRng = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With

srcRng.Copy _
Destination:=destRng

MsgBox "Data moved to the other sheet successfully", _
vbInformation, "Done"
End If
End With
End Sub

(Untested, but it compiled ok)

LoveCandle wrote:

Hi everybody,

I have these two codes:

The first one works on selecting specific records whose values are more
than zero, and the other one is working on copying the selected records
by the first code to another sheet.

I tried to merge them in one code to get the same purpose but I found
the second code move all records even those who have 0 value records,
so I would like you please to help me in this matter.

First Code:

Code:
--------------------
Sub Highlight ()
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long

With ActiveSheet
FirstRow = 7
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = FirstRow To LastRow
If .Cells(iRow, "A").Value 0 Then
If myRng Is Nothing Then
Set myRng = .Cells(iRow, "A")
Else
Set myRng = Union(.Cells(iRow, "A"), myRng)
End If
End If
Next iRow

If myRng Is Nothing Then
MsgBox "No records to select"
Else
Intersect(myRng.EntireRow, .Range("a:j")).Select
End If
End With

End Sub
--------------------

Second Code:

Code:
--------------------
Sub Copy_Move()
Dim srcRng As Range
Dim destRng As Range
Dim Lrow As Long
Lrow = Cells(Rows.Count, "A").End(xlUp).Row
Set srcRng = ActiveSheet.Range("A7:J" & Lrow)
Set destRng = Sheets("100"). _
Cells(Rows.Count, "A").End(xlUp)(2)
srcRng.Copy Destination:=destRng
MsgBox "Data moved to the other sheet successfully", vbInformation, "Done"
End Sub
--------------------

--
LoveCandle
------------------------------------------------------------------------
LoveCandle's Profile: http://www.excelforum.com/member.php...o&userid=28612
View this thread: http://www.excelforum.com/showthread...hreadid=487729

--

Dave Peterson

Merging Two Codes Into one code
 

Thank you sooooooooo much that is really fantastic and what I need
exactly,

I have also another two codes need to be merged, I almost succeeded
merging them but the problem is that the second code which should be
working on the sheets2, it works on the active sheet instead I don't
know why!!!

First Code:

Code:
--------------------
Public Sub Tarheel()
If [B6].Value = "" Then
MsgBox "No records to be moved to the other sheet", vbExclamation, "Sorry"
Else
Dim srcRng As Range
Dim destRng As Range
Dim Lrow As Long
Lrow = Cells(Rows.Count, "B").End(xlUp).Row
Set srcRng = ActiveSheet.Range("B6:W" & Lrow)
Set destRng = Sheets("sheet2"). _
Cells(Rows.Count, "B").End(xlUp)(2)
srcRng.Copy Destination:=destRng
srcRng.ClearContents
MsgBox "Records were successfully moved", vbInformation, "Done"
End If
End Sub
--------------------

Second Code:

Code:
--------------------
Sub Numbering()
With sheets2
For i = 2 To Cells(Rows.Count, "B").End(xlUp).Row
If Cells(i, "B").Value < "" Then
Cells(i, "A").Value = i - 1
End If
Next i
End With
End Sub
--------------------

Codes after merging,

Code:
--------------------
Public Sub Tarheel()
If [B6].Value = "" Then
MsgBox "No records to be moved to the other sheet", vbExclamation, "Sorry"
Else
Dim srcRng As Range
Dim destRng As Range
Dim Lrow As Long
Lrow = Cells(Rows.Count, "B").End(xlUp).Row
Set srcRng = ActiveSheet.Range("B6:W" & Lrow)
Set destRng = Sheets("sheet2"). _
Cells(Rows.Count, "B").End(xlUp)(2)
srcRng.Copy Destination:=destRng
srcRng.ClearContents
With sheets2
For i = 2 To Cells(Rows.Count, "B").End(xlUp).Row
If Cells(i, "B").Value < "" Then
Cells(i, "A").Value = i - 1
End If
Next i
End With
"Records were successfully moved", vbInformation, "Done"
End If
End Sub
--------------------


Thank you,


--
LoveCandle
------------------------------------------------------------------------
LoveCandle's Profile: http://www.excelforum.com/member.php...o&userid=28612
View this thread: http://www.excelforum.com/showthread...hreadid=487729

Merging Two Codes Into one code
 

Maybe....

Option Explicit
Public Sub Tarheel()
Dim srcRng As Range
Dim destRng As Range
Dim Lrow As Long
If ActiveSheet.Range("b6").Value = "" Then
MsgBox "No records to be moved to the other sheet", _
vbExclamation, "Sorry"
Else
Lrow = Cells(Rows.Count, "B").End(xlUp).Row
Set srcRng = ActiveSheet.Range("B6:W" & Lrow)
Set destRng = Sheets("sheet2"). _
Cells(Rows.Count, "B").End(xlUp)(2)
srcRng.Copy Destination:=destRng
srcRng.ClearContents
With Worksheets("sheet2")
For i = 2 To .Cells(.Rows.Count, "B").End(xlUp).Row
If .Cells(i, "B").Value < "" Then
.Cells(i, "A").Value = i - 1
End If
Next i
End With
MsgBox "Records were successfully moved", vbInformation, "Done"
End If
End Sub

I changed this line:
with sheets2
to
With Worksheets("sheet2")
(change it to what you need)

And when you use "with/end with", you'll need leading dots on the things that
belong to that "with" object.

.cells(i,"B").value....
with the dot in front of cells, excel knows that it belongs to the object in the
previous With statement.

Without the dot, excel knows that you mean the activesheet (well, in a general
module).




LoveCandle wrote:

Thank you sooooooooo much that is really fantastic and what I need
exactly,

I have also another two codes need to be merged, I almost succeeded
merging them but the problem is that the second code which should be
working on the sheets2, it works on the active sheet instead I don't
know why!!!

First Code:

Code:
--------------------
Public Sub Tarheel()
If [B6].Value = "" Then
MsgBox "No records to be moved to the other sheet", vbExclamation, "Sorry"
Else
Dim srcRng As Range
Dim destRng As Range
Dim Lrow As Long
Lrow = Cells(Rows.Count, "B").End(xlUp).Row
Set srcRng = ActiveSheet.Range("B6:W" & Lrow)
Set destRng = Sheets("sheet2"). _
Cells(Rows.Count, "B").End(xlUp)(2)
srcRng.Copy Destination:=destRng
srcRng.ClearContents
MsgBox "Records were successfully moved", vbInformation, "Done"
End If
End Sub
--------------------

Second Code:

Code:
--------------------
Sub Numbering()
With sheets2
For i = 2 To Cells(Rows.Count, "B").End(xlUp).Row
If Cells(i, "B").Value < "" Then
Cells(i, "A").Value = i - 1
End If
Next i
End With
End Sub
--------------------

Codes after merging,

Code:
--------------------
Public Sub Tarheel()
If [B6].Value = "" Then
MsgBox "No records to be moved to the other sheet", vbExclamation, "Sorry"
Else
Dim srcRng As Range
Dim destRng As Range
Dim Lrow As Long
Lrow = Cells(Rows.Count, "B").End(xlUp).Row
Set srcRng = ActiveSheet.Range("B6:W" & Lrow)
Set destRng = Sheets("sheet2"). _
Cells(Rows.Count, "B").End(xlUp)(2)
srcRng.Copy Destination:=destRng
srcRng.ClearContents
With sheets2
For i = 2 To Cells(Rows.Count, "B").End(xlUp).Row
If Cells(i, "B").Value < "" Then
Cells(i, "A").Value = i - 1
End If
Next i
End With
"Records were successfully moved", vbInformation, "Done"
End If
End Sub
--------------------

Thank you,

--
LoveCandle
------------------------------------------------------------------------
LoveCandle's Profile: http://www.excelforum.com/member.php...o&userid=28612
View this thread: http://www.excelforum.com/showthread...hreadid=487729

--

Dave Peterson

Merging Two Codes Into one code
 

Thank you for helping me in this case Mr. Dave

When I run the code it stop at letter i of this line


Code:
--------------------
For i = 2 To .Cells(.Rows.Count, "B").End(xlUp).Row
--------------------


and when I run the numbering code only it works perperly, I don't know
why, you may try and find out the problem.

Thanks,


--
LoveCandle
------------------------------------------------------------------------
LoveCandle's Profile: http://www.excelforum.com/member.php...o&userid=28612
View this thread: http://www.excelforum.com/showthread...hreadid=487729

Merging Two Codes Into one code
 

I think you may have changed something from the suggested code.

You'll have to post the code you're using.

LoveCandle wrote:

Thank you for helping me in this case Mr. Dave

When I run the code it stop at letter i of this line

Code:
--------------------
For i = 2 To .Cells(.Rows.Count, "B").End(xlUp).Row
--------------------

and when I run the numbering code only it works perperly, I don't know
why, you may try and find out the problem.

Thanks,

--
LoveCandle
------------------------------------------------------------------------
LoveCandle's Profile: http://www.excelforum.com/member.php...o&userid=28612
View this thread: http://www.excelforum.com/showthread...hreadid=487729

--

Dave Peterson

Merging Two Codes Into one code
 

I copied the code again and pasted it in the module and the same problem
appeared I don't kow why!!!

Can U please help me, and attach me a file if u can

Thank you,


--
LoveCandle
------------------------------------------------------------------------
LoveCandle's Profile: http://www.excelforum.com/member.php...o&userid=28612
View this thread: http://www.excelforum.com/showthread...hreadid=487729

Merging Two Codes Into one code
 

I don't open workbooks.

But you can post the current version of your code.



LoveCandle wrote:

I copied the code again and pasted it in the module and the same problem
appeared I don't kow why!!!

Can U please help me, and attach me a file if u can

Thank you,

--
LoveCandle
------------------------------------------------------------------------
LoveCandle's Profile: http://www.excelforum.com/member.php...o&userid=28612
View this thread: http://www.excelforum.com/showthread...hreadid=487729

--

Dave Peterson

Merging Two Codes Into one code
 

I am using the same code mentioned above,


Code:
--------------------
Option Explicit
Public Sub Tarheel()
Dim srcRng As Range
Dim destRng As Range
Dim Lrow As Long
If ActiveSheet.Range("b6").Value = "" Then
MsgBox "No records to be moved to the other sheet", _
vbExclamation, "Sorry"
Else
Lrow = Cells(Rows.Count, "B").End(xlUp).Row
Set srcRng = ActiveSheet.Range("B6:W" & Lrow)
Set destRng = Sheets("sheet2"). _
Cells(Rows.Count, "B").End(xlUp)(2)
srcRng.Copy Destination:=destRng
srcRng.ClearContents
With Worksheets("sheet2")
For i = 2 To .Cells(.Rows.Count, "B").End(xlUp).Row
If .Cells(i, "B").Value < "" Then
.Cells(i, "A").Value = i - 1
End If
Next i
End With
MsgBox "Records were successfully moved", vbInformation, "Done"
End If
End Sub
--------------------


--
LoveCandle
------------------------------------------------------------------------
LoveCandle's Profile: http://www.excelforum.com/member.php...o&userid=28612
View this thread: http://www.excelforum.com/showthread...hreadid=487729

Merging Two Codes Into one code
 

In your code, there are references to Sheet2 and activesheet.

Option Explicit
Public Sub Tarheel()
Dim srcRng As Range
Dim destRng As Range
Dim i As Long
Dim Lrow As Long
If ActiveSheet.Range("b6").Value = "" Then
MsgBox "No records to be moved to the other sheet", _
vbExclamation, "Sorry"
Else
Lrow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
Set srcRng = ActiveSheet.Range("B6:W" & Lrow)
Set destRng = Sheets("sheet2").Cells(Rows.Count, "B").End(xlUp)(2)
srcRng.Copy Destination:=destRng
srcRng.ClearContents
With Worksheets("sheet2")
For i = 2 To .Cells(.Rows.Count, "B").End(xlUp).Row
If .Cells(i, "B").Value < "" Then
.Cells(i, "A").Value = i - 1
End If
Next i
End With
MsgBox "Records were successfully moved", vbInformation, "Done"
End If
End Sub

Are they pointing to the correct sheets for you?

Your code worked ok for me--although, that doesn't mean it does what you want.



LoveCandle wrote:

I am using the same code mentioned above,

Code:
--------------------
Option Explicit
Public Sub Tarheel()
Dim srcRng As Range
Dim destRng As Range
Dim Lrow As Long
If ActiveSheet.Range("b6").Value = "" Then
MsgBox "No records to be moved to the other sheet", _
vbExclamation, "Sorry"
Else
Lrow = Cells(Rows.Count, "B").End(xlUp).Row
Set srcRng = ActiveSheet.Range("B6:W" & Lrow)
Set destRng = Sheets("sheet2"). _
Cells(Rows.Count, "B").End(xlUp)(2)
srcRng.Copy Destination:=destRng
srcRng.ClearContents
With Worksheets("sheet2")
For i = 2 To .Cells(.Rows.Count, "B").End(xlUp).Row
If .Cells(i, "B").Value < "" Then
.Cells(i, "A").Value = i - 1
End If
Next i
End With
MsgBox "Records were successfully moved", vbInformation, "Done"
End If
End Sub
--------------------

--
LoveCandle
------------------------------------------------------------------------
LoveCandle's Profile: http://www.excelforum.com/member.php...o&userid=28612
View this thread: http://www.excelforum.com/showthread...hreadid=487729

--

Dave Peterson

Merging Two Codes Into one code
 

When you use option explicit, you have to declare all the variables with
dim statement. In your code variable i was not declare. So just add this
line to your code after this line .... Dim Lrow As Longdim .

Dim i as long


For more info see VBA Help for option explicit statement &
writting declare statements.

Regards,
Shah Shailesh
http://members.lycos.co.uk/shahweb/
http://in.geocities.com/shahshaileshs/
(Excel Add-ins Page)

*** Sent via Developersdex http://www.developersdex.com ***

Merging Two Codes Into one code
 

Thank you sooooooooooo much ,, that is exaclty what I want ..

Thank you for the effort you exerted for me,


--
LoveCandle
------------------------------------------------------------------------
LoveCandle's Profile: http://www.excelforum.com/member.php...o&userid=28612
View this thread: http://www.excelforum.com/showthread...hreadid=487729