VBA to paste values into a column based on a given condition

[markinho10]

Hi All,

I've created a VBA code which lists the values to column B from column A which are above/below a certain amount (amount is in cell B1 and can be modified per user preferences). However I also would like to list the deal IDs starting from cell D4, next to column B which are meeting the condition if value in col A is above/below a certain amount. E.g. the first amount in col A above 100,000, it is going to be listed in col B but I'd like to have the respective deal ID from col D next to it. I've uploaded a picture of the sheet. Could you please help me? Thank you in advance!

VBA code to list the items from col A to col B which are above/below B1 value is the following:

Option Explicit
Sub test()
Dim a As Range, outA As Range
Dim CellValue As Long
CellValue = Range("b1").Value
Set outA = Worksheets(1).Range("b4")
For Each a In Worksheets(1).UsedRange.Columns(1).Cells
If a > CellValue Or a < CellValue * (-1) And IsNumeric(a.Value) Then
outA = a.Value

Set outA = outA.Offset(1, 0)

End If
Next a

End Sub

 

[Fluff]

Hi & welcome to MrExcel.
How about

Sub markinho()
   Dim Cl As Range
   Dim i As Long
   
   i = 4
   With Worksheets(1)
      For Each Cl In .Range("A4", .Range("A" & Rows.Count).End(xlUp))
         If IsNumeric(Cl.Value) And (Cl.Value >= .Range("B1").Value Or Cl.Value < .Range("B1").Value * -1) Then
            With .Range("B" & i)
               .Value = Cl.Value
               .Offset(, 1).Value = Cl.Offset(, 3).Value
            End With
            i = i + 1
         End If
      Next Cl
   End With
End Sub

 

[markinho10]

Hi & welcome to MrExcel.
How about

Sub markinho()
   Dim Cl As Range
   Dim i As Long
  
   i = 4
   With Worksheets(1)
      For Each Cl In .Range("A4", .Range("A" & Rows.Count).End(xlUp))
         If IsNumeric(Cl.Value) And (Cl.Value >= .Range("B1").Value Or Cl.Value < .Range("B1").Value * -1) Then
            With .Range("B" & i)
               .Value = Cl.Value
               .Offset(, 1).Value = Cl.Offset(, 3).Value
            End With
            i = i + 1
         End If
      Next Cl
   End With
End Sub

Thanks vm! It worked perfectly! Highly appreciate your quick and useful response!

 

[Fluff]

You're welcome & thanks for the feedback.