Copy entire row based on condition-i have the code-help plz

lundbhaiz

Active Member
Joined
Feb 16, 2010
Messages
386
Code:
Sub CondCopy()


    ThisWorkbook.Activate
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "MySheet"


    Sheets("JCR").Select
    Rows(1).Copy
    
    Sheets("MySheet").Activate
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.Font.Bold = True
    
    Application.CutCopyMode = False
        
    Sheets("JCR").Select
    RowCount = Cells(Cells.Rows.Count, "A").End(xlUp).Row
    For i = 1 To RowCount
    
        Range("A" & i).Select
        Check_value = ActiveCell
        If Check_value <> 0 Then
            ActiveCell.EntireRow.Copy
            Sheets("MySheet").Select
            RowCount = Cells(Cells.Rows.Count, "A").End(xlUp).Row
            Range("A" & RowCount + 1).Select
            ActiveSheet.Paste
            Sheets("MySheet").Select
        End If
    Next
End Sub

hi. this is my code. i want to copy entire row to sheet called "MySheet" from sheet "JCR". the copy entire row is base on a condition that if the cell value in column A is not equal to zero then copy entire row and paste it in "MySheet" from row 2. I make this code and run this code and it goes into infinite loop. plz some help me because i cannot see and understand what and where is it going wrong.
 

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
I just read your post again and I realized that the columns don't match. This means we're back to the original JCR-only code.


The logic behind the macro is simple. As always, the first part (the Dims) is a declaration of every object/range/whathaveyou we will be using. There, I declared ever worksheet and range and numbers I am using.


Code:
Dim wbk As Workbook
Dim wjcr As Worksheet
Dim wcwip As Worksheet
Dim wowip As Worksheet
Dim lrow As Range
Dim i As Long
Dim j As Long
Dim k As Long
Dim l As Long
Dim m as Long
Dim n as Long


After that, I set the "target locations" of each "location-based variable" (ranges, worksheets, cells go here).


Code:
Set wbk = Application.ThisWorkbook
Set wjcr = wbk.Worksheets("JCR")
Set wcwip = wbk.Worksheets("CWIP")
Set wowip = wbk.Worksheets("OWIP")


Next would be the creation of the MySheet. This is the first 'action' I'll be creating so I placed the error handling part first. This means that if the subsequent content gets an error, I will jump immediately to the part right after the errHandle: label.


Code:
On Error GoTo errHandle:
wbk.Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "MySheet"


Next, after creating the worksheet, I declare it as a worksheet then proceeded to set it to a variable like what I did above it.


Code:
Dim wmys As Worksheet
Set wmys = wbk.Worksheets("Mysheet")


Then, I assign numbers to the Long declarations j, l, and n. What each of the lines below does is simply go into the the respective sheet (wjcr,wcwip,wowip), start from the bottom cell of the first column (Cells(Rows.Count, 1)), then emulate pressing Ctrl-Up to get to the last row in that sheet with a value. Appending .Row to it returns the number of that row which is important in the next part.


Code:
j = wjcr.Cells(Rows.Count, 1).End(xlUp).Row
l = wcwip.Cells(Rows.Count, 1).End(xlUp).Row
n = wowip.Cells(Rows.Count, 1).End(xlUp).Row


We manipulate two things to help speed things up.


Code:
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


Then we start with the loops. What this does is simple go through the rows one by one. If you notice, the first line is For i = 1 to j. Read in English, this is worded as, "For the value of i from 1 to the number of rows associated with j...".


The next few lines basically check for the value of column A in that row (Range("A" & i).Value <> 0) and sets the target location of the pasting. This should be inside the loop because every iteration of the copying must locate the newest next empty row. Setting it before would just result into the loop overwriting one row over and over.


Code:
For i = 1 To j
    If wjcr.Range("A" & i).Value <> 0 Then
        Set lrow = wmys.Cells(Rows.Count, 1).End(xlUp).Offset(1)
        wjcr.Range("A" & i).EntireRow.Copy
        lrow.PasteSpecial
    End If
Next i


The above is read as, "From row value 1 to the maximum row number j, if JCR's respective row has a column A value not equal to 0, then locate the next empty row in MySheet and copy the row from JCR to the empty row in MySheet.". Not so confusing now is it?


The following parts are just some more loops and just closing the other parts. Error handling is basically identifying any error numbers that might come about and 'trapping' them so that the debug error never comes up but instead notifies you of what error you are encountering. This one is a debugging issue and not really something you have to worry about if everything is done correctly.


Hope this helps. :)
 
Upvote 0
Let us know if there's anything else you need. I sincerely suggest that if the two other sheets have differently ordered columns compared to JCR and MySheet, that you altogether request for a different macro that arranges columns for you. That one is not difficult but forum rules dictate that you should start any new request with a new post. :)

Hope I was of help. For now, I think the original JCR macro works perfectly.
 
Upvote 0
Let us know if there's anything else you need. I sincerely suggest that if the two other sheets have differently ordered columns compared to JCR and MySheet, that you altogether request for a different macro that arranges columns for you. That one is not difficult but forum rules dictate that you should start any new request with a new post. :)

Hope I was of help. For now, I think the original JCR macro works perfectly.

Ofcourse it work correctly dear. thanks you very much for all help and i realy appreciate the kind helps. one little concern - i think i can modify your code in order to make another macro combined for owip and cwip from this code itself so just need to confirm if i can do it from your view of vba program expert level knowledge. i think i can do it so asking from you too.

above all i thanks you very heartily for helps me out in this coding. thanks you for kind helps jmonty -and this topic is now resolve and done :)
 
Upvote 0
It can be done. Believe it or not, I've only taught myself VBA. I used the Record Macro extensively and just read what people here are posting time and again. It's taxing, I know, but it's one of the best things. I refuse to ask until the very last because that way you can really see past the text and into the method. Remember that VBA is part trickery. There are a lot of things done that are only for purposes of getting it quicker.

In any case you want to create your own code, check back on this post. I tried to incorporate a lot of clean code above so that later on it's easy to tell what happened and why. Thank you for the feedback and I hope you enjoy your day!

J.
 
Upvote 0
It can be done. Believe it or not, I've only taught myself VBA. I used the Record Macro extensively and just read what people here are posting time and again. It's taxing, I know, but it's one of the best things. I refuse to ask until the very last because that way you can really see past the text and into the method. Remember that VBA is part trickery. There are a lot of things done that are only for purposes of getting it quicker.

In any case you want to create your own code, check back on this post. I tried to incorporate a lot of clean code above so that later on it's easy to tell what happened and why. Thank you for the feedback and I hope you enjoy your day!

J.

this is fantastic and needless to say you do it with very nice explains. thanks you and my greetings to you also. :)
 
Upvote 0

Forum statistics

Threads
1,220,965
Messages
6,157,120
Members
451,399
Latest member
alchavar

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top