IF cells in column A are greater/less than zero, then only paste those cells in column B

[Jeevz_87]

Hi All,


I have an issue with vba code that im trying to write where I want to only copy cells of a certain value over into another column on the same sheet.

I need my code to loop through cells in column A, find all cells with a value greater or less than zero and paste those cells into column B in the same worksheet. The paste should not overwrite any values in column B that already contain values. I also want the code to select the entire column every time for both procedures

So far I have been experimenting with a piece of code I modified for another task but not sure sure how to adapt it with the IF statement in this case;

Sub Copy_P123()

    Range("Z12").Select 'Column A selection
    
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("BL12").Select 'Column B paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

Seems like every task I'm currently doing in VBA requires me to ask new questions as the requirements are never the same, hence I'll always ask weird and wonderful questions.

I would be greatly appreciative of any help re: the above

Many thanks,


Jeevz

 

[rlv01]

a value greater or less than zero

I intepret that as cells that do not equal 0

One way

Sub Copy_P123()
    Dim WS As Worksheet
    Dim CellRange As Range, R As Range

    Set WS = ActiveSheet
    With WS
        Set CellRange = .Range("A2", .Range("A" & .Rows.count).End(xlUp))    'alt range to last cell in column w/data
    End With

    For Each R In CellRange
        If R.Value <> 0 And VBA.IsNumeric(R.Value) Then
            If Trim(R.Offset(0, 1).Value) = "" Then
                R.Offset(0, 1).Value = R.Value
            End If
        End If
    Next R
End Sub

 

[rollis13]

Oh, I'm late. Anyway, here's what I came up with. Paste this macro into a standard module.
I'm assuming that row 1 in sheet 1 is for headers and data starts from A2.

Option Explicit
Sub CopyLessOrGreater()
    With Sheets(1)
        .AutoFilterMode = False
        With .Range("A1", .Range("A" & Rows.Count).End(xlUp))
            .AutoFilter Field:=1, Criteria1:="<>0"
            On Error Resume Next
            .Offset(1).SpecialCells(xlCellTypeVisible).Copy .Range("B" & .Cells(Rows.Count, "B").End(xlUp).Row + 1)
            On Error GoTo 0
        End With
        .AutoFilterMode = False
    End With
End Sub

 

[Jeevz_87]

Hi rlv01 & rollis13,

Yes you'd be correcting in assuming as much.

The idea here is to be able to loop each row in column A (starting at AB12 for example) and seeing which cells are greater than or less than 0. Then pasting those figures, in the same rows into column B (BN12). I dont mind the pasted figures overwriting anything already in the cell.

If I can make this work, the next phase will be to apply it to the remaining balance of column, but of course it depends if this initial macro works first in the above fashion.

 

[cadandcode]

=IF(AND(B43<>0),B43,"")

Kitap3.xlsx.xlsm
	B	C
43	1	1
44	2	2
45	1	1
46	2	2
47	1	1
48	-1	-1
49	-1	-1
50	-2	-2
51	0
03.02.23

Cell Formulas
Range	Formula
C43:C51	C43	=IF(AND(B43<>0),B43,"")