Copy values if zero, if not zero.

[Charles_]

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

"

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

"

 

[Rick Rothstein]

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.

' 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

 

[Charles_]

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.

' 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

 

[Beta Test Team]

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

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.

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