Copy values if zero, if not zero.

Charles_

New Member
Joined
Dec 12, 2012
Messages
32
Hi there,

I am running into an issue when trying to run the following:

*If values in column A are greater than zero, paste values in column C
*If values in column A are zero, copy values from column B (in same row) and paste in column C

Columns are of variable lenght and values begin from A2 onwards.

So far, I've tried the first step only without success using the below. Ideally I would not like to choose "range A:A)" but something that will run trough cells with data only.

Can somebody please point me in the right direction?

Thanks!!!

"
Code:
Sub CopyValues()
     
    Dim x As Range
    For Each x In Range("A:A")
        If x.Value > 0 Then
            x.Select
            Selection. Copy
            Columns("C:2").Select
    ActiveSheet.Paste
            End If
    Next i

Dim z As Range
    For Each z In Range("A:A")
        If z.Value = 0 Then
            Columns("B:B").Select
            Selection. Copy
            Columns("C:2").Select
    ActiveSheet.Paste
            End If
    Next z


End Sub
"
 
Last edited by a moderator:
Thank you Rick!
You are quite welcome. I just want to mention that the code I gave you is reasonably fast if you do not have a huge amount of data. The rountines below (which can be used for small and large amounts of data) is one of the faster code routines you will find for handling large amounts of data. It uses loops, but the looping takes place all in memory rather than repeatedly calling out to the worksheet. First, it copies all the data into memory, processes that data according to your rules and then "blasts" all the values back to the worksheet.
Code:
' Processes 0's and >0's in Column A
Sub CopyValues3()
  Dim X As Long, vArr As Variant
  vArr = Range("A2:C" & Cells(Rows.Count, "A").End(xlUp).Row)
  For X = 1 To UBound(vArr)
    If vArr(X, 1) >= 0 Then vArr(X, 3) = vArr(X, 2 + (vArr(X, 1) > 0))
  Next
  Range("A2:C" & Cells(Rows.Count, "A").End(xlUp).Row) = vArr
End Sub

' Processes OK's in Column D
Sub CopyValues4()
  Dim X As Long, vArr As Variant
  vArr = Range("A2:D" & Cells(Rows.Count, "A").End(xlUp).Row)
  For X = 1 To UBound(vArr)
    vArr(X, 3) = vArr(X, 2 + (vArr(X, 4) = "OK"))
  Next
  Range("A2:D" & Cells(Rows.Count, "A").End(xlUp).Row) = vArr
End Sub
 
Upvote 0

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.
Fantastic, I may use this code actually.

Thanks again!

You are quite welcome. I just want to mention that the code I gave you is reasonably fast if you do not have a huge amount of data. The rountines below (which can be used for small and large amounts of data) is one of the faster code routines you will find for handling large amounts of data. It uses loops, but the looping takes place all in memory rather than repeatedly calling out to the worksheet. First, it copies all the data into memory, processes that data according to your rules and then "blasts" all the values back to the worksheet.
Code:
' Processes 0's and >0's in Column A
Sub CopyValues3()
  Dim X As Long, vArr As Variant
  vArr = Range("A2:C" & Cells(Rows.Count, "A").End(xlUp).Row)
  For X = 1 To UBound(vArr)
    If vArr(X, 1) >= 0 Then vArr(X, 3) = vArr(X, 2 + (vArr(X, 1) > 0))
  Next
  Range("A2:C" & Cells(Rows.Count, "A").End(xlUp).Row) = vArr
End Sub

' Processes OK's in Column D
Sub CopyValues4()
  Dim X As Long, vArr As Variant
  vArr = Range("A2:D" & Cells(Rows.Count, "A").End(xlUp).Row)
  For X = 1 To UBound(vArr)
    vArr(X, 3) = vArr(X, 2 + (vArr(X, 4) = "OK"))
  Next
  Range("A2:D" & Cells(Rows.Count, "A").End(xlUp).Row) = vArr
End Sub
 
Upvote 0
Hi Rick,

I'm hoping you (or anyone here) can help me with what I assume is a very simple task (that I'm failing at right now).

Here is a different macro that will do what you asked for originally without looping through the cells...
Code:
Sub CopyValues1()
  Dim LastRow As Long
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Range("C2:C" & LastRow) = Evaluate("IF(A2:A" & LastRow & "=0,B2:B" & LastRow & ",IF(A2:A" & _
                                     LastRow & ">0,A2:A" & LastRow & ",C2:C" & LastRow & "))")
End Sub

I'm using your VBA (thanks!) but I need to specify the worksheet because this macro is assigned to a function button on a different sheet. So when that button is clicked data is copied from that sheet (copySheet) to the target sheet (pasteSheet), where your VBA then runs.

Here's what I have from your VBA. The first part for the copySheet and pasting into pasteSheet works fine. But your VBA runs on the copySheet, not the pasteSheet.

When I use your VBA from a form button on the same sheet as the values to convert it works very well, thank you.

I want to copy cells with values less than the max data set value from column A and paste into column C (same rows), and for those that are the same as the max data set value in column A, they should pasted into column C as zero (from column B). When running this from a forms button on the same sheet it works like a charm.

In the VBA below where you have ">0" and "=0" my VBA has "<d2" and="" "="D2"." i'm="" using="" the="" max="" value="" in="" place="" of="" zero="" that="" original="" question="" posed.="" i="" can't="" add="" those="" two="" changes="" to="" post,="" it="" breaks="" code="" box.=""
= D2" (without a space) and "< D2" (without a space). I had do post this way because whenever I post those two latter values without the space they do not show up in the post box.

Cell D2 is the max value of the cell range in column A, I'm using the max data set value in place of zero in your VBA.

Code:
Sub copyConvert()

  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
    
  Dim copySheet As Worksheet
  Dim pasteSheet As Worksheet
  Dim LastRow As Long

  Set copySheet = Worksheets("sheet1")
  Set pasteSheet = Worksheets("sheet2")
    
  copySheet.Range("P1:P115").Copy
  pasteSheet.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
     :=False, Transpose:=False
    
  Application.CutCopyMode = False
  Application.DisplayAlerts = True

  With pasteSheet

    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    Range("C2:C" & LastRow) = Evaluate("IF(A2:A" & LastRow & "=0,B2:B" & LastRow & ",IF(A2:A" & _
                                       LastRow & ">0,A2:A" & LastRow & ",C2:C" & LastRow & "))")

  End With

  Application.ScreenUpdating = True

End Sub
</d2">
 
Upvote 0

Forum statistics

Threads
1,223,099
Messages
6,170,107
Members
452,302
Latest member
TaMere

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