CODEWITHSUNDEEP
vbaexcel
Elixir
Elixir

Reputation: 303

VBA Copy Paste string search

I can’t seem to figure out how to write a vba code that search’s through cells C10:G10 to find a match that equals cell A10, once found, copies range A14:A18 to the matched cell but below e.g F14:F18 (See Image)

Macro below

'Copy
Range("A14:A18").Select
Selection.Copy
'Paste
Range("F14:F18").Select
ActiveSheet.Paste!

Attached image click here

Upvotes: 0

Views: 2482

Answers (4)

L42
L42

Reputation: 19727

Try this:

With Sheets("SheetName") ' Change to your actual sheet name
    Dim r As Range: Set r = .Range("C10:G10").Find(.Range("A10").Value2, , , xlWhole)
    If Not r Is Nothing Then r.Offset(4, 0).Resize(5).Value2 = .Range("A14:A18").Value2
End With

Range Object have Find Method to help you find values within your range.
The Range object that matches your search criteria is then returned.
To get your values to the correct location, simply use Offset and Resize Method.

Edit1: To answer OP's comment

To find formulas in Ranges, you need to set LookIn argument to xlFormulas.

Set r = .Range("C10:G10").Find(What:=.Range("A10").Formula, _
                               LookIn:=xlFormulas, _
                               LookAt:=xlWhole)

Above code find Ranges with exactly the same formula as Cell A10.

Upvotes: 2

Davesexcel
Davesexcel

Reputation: 6984

Here you go,

    Sub DoIt()
    Dim rng As Range, f As Range
    Dim Fr As Range, Crng As Range

    Set Fr = Range("A10")
    Set Crng = Range("A14:A18")
    Set rng = Range("C10:G19")
    Set f = rng.Find(what:=Fr, lookat:=xlWhole)

    If Not f Is Nothing Then
        Crng.Copy Cells(14, f.Column)
    Else: MsgBox "Not Found"
        Exit Sub
    End If
End Sub

Upvotes: 0

Vasily
Vasily

Reputation: 5782

another additional variants

1.Using For each loop

Sub test()
Dim Cl As Range, x&

For Each Cl In [C10:G10]
    If Cl.Value = [A10].Value Then
        x = Cl.Column: Exit For
    End If
Next Cl

If x = 0 Then
    MsgBox "'" & [A10].Value & "' has not been found in range 'C10:G10'!"
    Exit Sub
End If

Range(Cells(14, x), Cells(18, x)).Value = [A14:A18].Value

End Sub

2.Using Find method (already posted by L42, but a bit different)

Sub test2()
Dim Cl As Range, x&

On Error Resume Next

x = [C10:G10].Find([A10].Value2, , , xlWhole).Column

If Err.Number > 0 Then
    MsgBox "'" & [A10].Value2 & "' has not been found in range 'C10:G10'!"
    Exit Sub
End If

[A14:A18].Copy Range(Cells(14, x), Cells(18, x))

End Sub

3.Using WorksheetFunction.Match

Sub test2()
Dim Cl As Range, x&

On Error Resume Next

x = WorksheetFunction.Match([A10], [C10:G10], 0) + 2

If Err.Number > 0 Then
    MsgBox "'" & [A10].Value2 & "' has not been found in range 'C10:G10'!"
    Exit Sub
End If

[A14:A18].Copy Range(Cells(14, x), Cells(18, x))

End Sub

Upvotes: 0

rey
rey

Reputation: 27

Dim RangeToSearch As Range
Dim ValueToSearch
Dim RangeToCopy As Range
Set RangeToSearch = ActiveSheet.Range("C10:G10")
Set RangeToCopy = ActiveSheet.Range("A14:A18")

ValueToSearch = ActiveSheet.Cells(10, "A").Value
For Each cell In RangeToSearch
    If cell.Value = ValueToSearch Then
        RangeToCopy.Select
        Selection.Copy
        Range(ActiveSheet.Cells(14, cell.Column), _
            ActiveSheet.Cells(18, cell.Column)).Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        Exit For
    End If
Next cell

Upvotes: 1

Related Questions