Copy range of cells from one worksheet to another if cell has a specific valule

garbour

New Member
Joined
Jun 18, 2012
Messages
6
Hey all,

I have a simple VBA string of code that should look at a cell range and if the cell = 0 copy that row and past it into another sheet. If the cell does not = 0 the code should skip that row (don't copy anything) and move on to the next one. Here is my current code with some notes in red.

What should I be using for this line of code?

Sub Evaluate_Data()


'Declare variables
Dim intStartRow As Long
Dim intEndRow As Long
Dim intTargetColumn As Long
Dim intCounter As Integer

'set default values
intStartRow = Range("qty_range").Row
intEndRow = Range("qty_range").Row + Range("qty_range").Rows.Count - 1
intTargetColumn = Range("qty_range").Column

For intCounter = intStartRow To intEndRow
'if the cell contains a zero value
If Len(Trim(Cells(intCounter, intTargetColumn).Value)) = 0 Or Cells(intCounter, intTargetColumn).Value = 0 Then
' paste the value

[this line works, but it pastes every cell in the range] Range("qty_range").Copy

[what I want it to do is similar to my code to hide rows (see below) but instead paste the values)

Rows(intCounter & ":" & intCounter).EntireRow.Hidden = True]


Sheet3.Range("D1").PasteSpecial Paste:=xlPasteValues


End If
Next intCounter
End Sub


Thanks,

garbour
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce

Jerry Sullivan

MrExcel MVP
Joined
Mar 18, 2010
Messages
8,787
Hi garbour and Welcome to the Board,

Here's two ways to reference just the row and columns that you want to copy instead of the entire named range.

Code:
           Intersect(Range("qty_range"), Rows(intCounter)).Copy

Code:
           Range("qty_range").Resize(1).Offset(intCounter - intStartRow).Copy

You'll also need to add a means to go to the next blank row on Sheet3.

You might consider using AdvancedFilter as a more efficient way to accomplish this task- particularly if you have large datasets.
 
Upvote 0

garbour

New Member
Joined
Jun 18, 2012
Messages
6
So I worked on the code based on Jerry's recommendation (thanks Jerry!) and the code properly copies the data from "qty_range". However, as Jerry mentioned, it pastes all of the copied data in 1 row, over and over until it has pasted all of the copied data. Can you or anyone help add the code I need below so it will paste in the next row down, and the next row down, and so on?

Thanks,


Sub Evaluate_Data()

'Declare variables
Dim intStartRow As Long
Dim intEndRow As Long
Dim intTargetColumn As Long
Dim intCounter As Integer

'set default values
intStartRow = Range("qty_range").Row
intEndRow = Range("qty_range").Row + Range("qty_range").Rows.Count - 1
intTargetColumn = Range("qty_range").Column

For intCounter = intStartRow To intEndRow
'if the cell contains a zero value
If Len(Trim(Cells(intCounter, intTargetColumn).Value)) = 0 Or Cells(intCounter, intTargetColumn).Value = 0 Then
' paste the value
Range("qty_range").Resize(1).Offset(intCounter - intStartRow).EntireRow.Copy
Sheet3.Range("A8").Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

CutCopyMode = False
End If


Next intCounter
End Sub


Garbour
 
Upvote 0

Jerry Sullivan

MrExcel MVP
Joined
Mar 18, 2010
Messages
8,787
Here's one way,

Code:
intCounter2 = intCounter2 + 1
Sheet3.Range("A8").Offset(intCounter2, 0).PasteSpecial _
    Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=


This assumes whenever you start your macro, Row 9 is your first blank row.
The approach would be different if you need to find the first blank row when you start your macro.
 
Upvote 0

garbour

New Member
Joined
Jun 18, 2012
Messages
6
ADVERTISEMENT
Hi Jerry, thanks again for your help. I am about as close as I can get (I think) without the code doing exactly what I want. Right now the code runs and copies all of the rows in the qty_range range regardless of whether or not there is a 0 or any other number or text in the column, and then it pastes the entire range into sheet3. Why is the code not just copying the rows that have a 0 in the first column of the range? Here is my current code:

Sub Evaluate_Data()

'Declare variables
Dim intStartRow As Long
Dim intEndRow As Long
Dim intTargetColumn As Long
Dim intCounter As Integer


'set default values
intStartRow = Range("qty_range").Row
intEndRow = Range("qty_range").Row + Range("qty_range").Rows.Count - 1
intTargetColumn = Range("qty_range").Column

For intCounter = intStartRow To intEndRow
'if the cell contains a zero value
If Len(Trim(Cells(intCounter, intTargetColumn).Value)) = 0 Or Cells(intCounter, intTargetColumn).Value = 0 Then
'copy the value
Range("qty_range").Resize(1).Offset(intCounter - intStartRow).EntireRow.Copy
' paste the value
intCounter2 = intCounter2 + 1
Sheet3.Range("A8").Offset(intCounter2, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False


CutCopyMode = False
End If


Next intCounter
End Sub



Thanks for your help!

garbour
 
Upvote 0

Jerry Sullivan

MrExcel MVP
Joined
Mar 18, 2010
Messages
8,787
What is the current address for "qty_range"?

Are you trying to copy and paste the entire worksheet's row or just values on the row within the range "qty_range"?
 
Upvote 0

garbour

New Member
Joined
Jun 18, 2012
Messages
6
ADVERTISEMENT
The address for "qty_range" is Estimate!$A$20:$A$319

Right now I have the code designed to copy the entire row. Once I get it to copy the correct rows I will tweak the code to copy a couple of columns.

Thanks for your help.

Garbour
 
Upvote 0

Jerry Sullivan

MrExcel MVP
Joined
Mar 18, 2010
Messages
8,787
The code works in my mockup when run from Estimate Sheet.

If a different sheet is active when you start the code, that might not work because all your references aren't qualified with references to the Sheets.

As an example, since there's no sheet explicitly referenced in this expression...
Code:
Cells(intCounter, intTargetColumn).Value

Excel interprets that as:
Code:
ActiveSheet.Cells(intCounter, intTargetColumn).Value

Which is okay if the ActiveSheet is "Estimate" but not if it's something else.

One way to qualify that is to add the Sheet reference like this...
Code:
Sheets("Estimate").Cells(intCounter, intTargetColumn).Value

You can check if that's the problem by starting with Estimate as the ActiveSheet.
If that isn't the problem, you can use Debug Tools in the VB Editor to step through each line of code as it is executed and see why every row is being copied.

Just ask if you want some help with how to do that.
 
Upvote 0

garbour

New Member
Joined
Jun 18, 2012
Messages
6
Hi Jerry,

I took a little break from debugging this code and started again yesterday. I stepped through each line and added a watch for "Value". Here is what watch returns:

"Break : : Value : Expression not defined in context : Empty : Module2<expression not="" defined="" in="" context=""><expression not="" defined="" in="" context="">"

Based on this code:

Sub Evaluate_Data()

'Declare variables
Dim intStartRow As Long
Dim intEndRow As Long
Dim intTargetColumn As Long
Dim intCounter As Integer


'set default values
intStartRow = Range("qty_range").Row
intEndRow = Range("</expression>qty_range<expression not="" defined="" in="" context="">").Row + Range("</expression>qty_range<expression not="" defined="" in="" context="">").Rows.Count - 1
intTargetColumn = Range("</expression>qty_range<expression not="" defined="" in="" context="">").Column

For intCounter = intStartRow To intEndRow
'if the cell contains a zero value
If Cells(intCounter, intTargetColumn).value = 0 Then
'copy the value
Range("</expression>qty_range<expression not="" defined="" in="" context="">").Resize(1).Offset(intCounter - intStartRow).EntireRow.Copy
' paste the value
intCounter2 = intCounter2 + 1
Sheet3.Range("A8").Offset(intCounter2, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False


CutCopyMode = False
End If


Next intCounter
End Sub








It seems like the code is ignoring</expression> the "Value = 0" test and just copying every row in the range.

Thanks,

Garbour
Excel 2010</expression>
 
Upvote 0

Jerry Sullivan

MrExcel MVP
Joined
Mar 18, 2010
Messages
8,787
I took a little break from debugging this code and started again yesterday. I stepped through each line and added a watch for "Value".

Value is a Property, and putting a watch on "Value" won't work without giving a reference to the Object whose Value you want to watch.

Try adding a Watch to this entire expression:
Code:
ActiveSheet.Cells(intCounter, intTargetColumn).Value

Another debugging technique is to print information to the Immediate Window.
Try adding the lines shown below, then stepping through your code.
Code:
[COLOR="#FF0000"]Option Explicit[/COLOR]

Sub Evaluate_Data2()
    'Declare variables
     Dim intStartRow As Long
     Dim intEndRow As Long
     Dim intTargetColumn As Long
     Dim intCounter As Integer, [COLOR="#FF0000"]intCounter2 As Integer[/COLOR]
 
    
    'set default values
     intStartRow = Range("qty_range").Row
     intEndRow = Range("qty_range").Row + Range("qty_range").Rows.Count - 1
     intTargetColumn = Range("qty_range").Column

     
     For intCounter = intStartRow To intEndRow
[COLOR="#0000CD"]        Debug.Print "Row: " & intCounter
        Debug.Print vbTab & "Test 1 evaluates to: " _
            & Len(Trim(Cells(intCounter, intTargetColumn).Value))
        Debug.Print vbTab & "Test 2 evaluates to: " _
            & Cells(intCounter, intTargetColumn).Value
        Debug.Print vbTab & "Result: " _
            & IIf(Len(Trim(Cells(intCounter, intTargetColumn).Value)) = 0 _
                Or Cells(intCounter, intTargetColumn).Value = 0, _
                "True - Copy Row", "False - Don't Copy")[/COLOR]
         'if the cell contains a zero value
        If Len(Trim(Cells(intCounter, intTargetColumn).Value)) = 0 _
            Or Cells(intCounter, intTargetColumn).Value = 0 Then
             'copy the value
             Range("qty_range").Resize(1).Offset(intCounter - intStartRow).EntireRow.Copy
             ' paste the value
             intCounter2 = intCounter2 + 1
             Sheet3.Range("A8").Offset(intCounter2, 0).PasteSpecial _
                Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
                False, Transpose:=False
            [COLOR="#FF0000"]Application.[/COLOR]CutCopyMode = False
         End If
     Next intCounter
 End Sub

Two points worth repeating...
1. Advanced Filter is a better way to do this task.
2. The code has some references that are not qualified with sheet references which can lead to unexpected results.
 
Upvote 0

Forum statistics

Threads
1,195,582
Messages
6,010,577
Members
441,557
Latest member
Jbest23

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
Top