PDA

View Full Version : Copy specific values



altrox5
09-26-2015, 11:44 AM
Hi,
I have code that should copy the all the values ​​fulfilling the conditions of array:ArrayCh

for some reason, the macro copies only the final result . Is anyone able to help me make the code was copied me all the cells containing the result?

here is the code



Function find_strings_2()

Dim ArrayCh() As Variant
Dim C As Range
Dim firstAddress As String
Dim i As Integer
Dim array_example(10)

ArrayCh = Array("Home", "Home2") 'strings to lookup

With ActiveSheet.Cells
For i = LBound(ArrayCh) To UBound(ArrayCh)
Set C = .Find(What:=ArrayCh(i), LookAt:=xlPart, LookIn:=xlValues)

If Not C Is Nothing Then
firstAddress = C.Address 'used later to verify if looping over the same address
Do

C.Copy
sheet2.Range("A1").PasteSpecial




Set C = .FindNext(C)

Loop While Not C Is Nothing And C.Address <> firstAddress


End If


Next i
End With

End Function

SamT
09-26-2015, 12:57 PM
You're pasting everything to the Same Range. Try

Dim Rw as long
Rw = 1

'Inside the loop
sheet2.Cells(Rw, "A").PasteSpecial
Rw = Rw + 1

BTW, The # Icon inserts VBA CODE Tags

altrox5
09-26-2015, 02:00 PM
You're pasting everything to the Same Range. Try

Dim Rw as long
Rw = 1

'Inside the loop
sheet2.Cells(Rw, "A").PasteSpecial
Rw = Rw + 1

BTW, The # Icon inserts VBA CODE Tags

still same effect.
the point is that function search and copy to sheet2 specific value among all values ​​contained in the row A
EXAMPLE:
ArrayCh = Array("value1","value2)

sheet1:
Columna A
rows
value1
value1
value3
value2

search and copy to sheet2: ArrayCh = Array("value1","value2)

p45cal
09-26-2015, 03:48 PM
in longhand, SamT's code:
Sub find_strings_2()
Dim ArrayCh() As Variant
Dim C As Range
Dim firstAddress As String
Dim i As Integer
Dim array_example(10)
Dim Rw As Long

Rw = 1
ArrayCh = Array("Home", "Home2") 'strings to lookup
With ActiveSheet.Cells
For i = LBound(ArrayCh) To UBound(ArrayCh)
Set C = .Find(What:=ArrayCh(i), LookAt:=xlPart, LookIn:=xlValues)
If Not C Is Nothing Then
firstAddress = C.Address 'used later to verify if looping over the same address
Do
C.Copy
Sheet2.Cells(Rw, "A").PasteSpecial
Rw = Rw + 1
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> firstAddress
End If
Next i
End With
End Sub

But…

the point is that function search and copy to sheet2 specific value among all values ​​contained in the row A
You realise the code you supplied searches the whole of the active sheet, not just column A?
To search just column A, change:
With ActiveSheet.Cells
to:
With ActiveSheet.columns(1)