Excel VBA - Search Range - If Cell Contains Text Then Copy Cell - Paste Offset 2,1

Question

I'm attempting to simplify an excel sheet I work with on a weekly basis.

I'm trying to create a VBA Macro that would do the following:

Search Column C for any Cells that contain Text, If Blank Ignore It
If text is found in a Cell, Copy That Cell, Paste the Contents Offset (2,1)

Any help anyone can give me, I would greatly appreciate. I have searched for other macros and have attempted to modify them for my use to no avail.

    **Example Before Macro**
  A       B       C       D       E
1                 Hi
2                 Test
3
4                 Done
5
6

**Example After Macro Has Been Run**
  A       B       C       D       E
1                 Hi
2                 Test
3                         Hi
4                 Done    Test
5
6                         Done

Current Code:

Sub CopyC()  
  Dim SrchRng As Range, cel As Range 
  Set SrchRng = Range("C1:C10") 

  For Each cel In SrchRng 
    If InStr(1, cel.Value) > 0 Then 
      cel.Offset(2, 1).Value = "-" 
    End If 
  Next cel 
End Sub

It sounds like this would be a simple For loop and If statement. What code do you currently have/have you tried? — TMH8885
'code'Sub CopyC() Dim SrchRng As Range, cel As Range Set SrchRng = Range("C1:C10") For Each cel In SrchRng If InStr(1, cel.Value) > 0 Then cel.Offset(2, 1).Value = "-" End If Next cel End Sub'code' — Ronnie G.
And cel.Offset(2, 1).Value = "-" to cel.Offset(2, 1).Value = cel.value — Scott Craner
@ScottCraner I changed the code to that; However, it only copies a blank text (That is because of my code, I do not know how to copy the cell's contents) and it does NOT ignore blank cells. — Ronnie G.

Scott Craner Scott Craner · Accepted Answer · 2016-01-22T19:47:44

You are Close:

Sub CopyC()
Dim SrchRng As Range, cel As Range
Set SrchRng = Range("C1:C10")
For Each cel In SrchRng
    If cel.Value <> "" Then
        cel.Offset(2, 1).Value = cel.Value
    End If
Next cel
End Sub

I added 1-6 in column D to show that it is ignoring the blanks

Excel VBA - Search Range - If Cell Contains Text Then Copy Cell - Paste Offset 2,1

1 Answers