Merging Two Codes Into one code

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:

Please Login or Register  to view this content.

Second Code:

Please Login or Register  to view this content.

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

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:

Please Login or Register  to view this content.

Second Code:

Please Login or Register  to view this content.

Codes after merging,

Please Login or Register  to view this content.

Thank you,

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

Thank you for helping me in this case Mr. Dave

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

Please Login or Register  to view this content.

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,

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

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,

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

I am using the same code mentioned above,

Please Login or Register  to view this content.

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

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 ***

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

Thank you for the effort you exerted for me,