Give this a try
Sub abc()
Dim a, b, w
Dim i As Long, ii As Long, n As Long
With Worksheets("data")
a = .Range("a4").CurrentRegion
End With
ReDim b(1 To UBound(a), 1 To 2)
For i = 2 To UBound(a)
ReDim w(0)
For ii = 3 To UBound(a, 2) Step 2
If a(i, ii) > 0.2 Then
w(UBound(w)) = a(1, ii)
ReDim Preserve w(UBound(w) + 1)
End If
Next
If Not IsEmpty(w(1)) Then
ReDim Preserve w(UBound(w) - 1): n = n + 1
b(n, 1) = a(i, 1): b(n, 2) = Join(w, ", ")
End If
Next
With Worksheets("extracted data")
.Cells(4, 1).Resize(, 2) = [{"address", "exceeded parameters"}]
.Cells(5, 1).Resize(n, 2) = b
End With
End Sub
Bookmarks