1

I am trying to move the cell value to adjacent cell if the string contains @ character in it. but the following Macro is not working as intended.

Sub Macro1()
  Dim MatchString As String
  MatchString = "@"
  For Counter = 1 To Range("A:A").Count
    If (InStr(Range("A" & Counter).Value, Len(MatchString)) = MatchString) Then
      Range("A" & Counter).Select
      Selection.Cut
      Range("B" & Counter).Select
      ActiveSheet.Paste
    End If
  Next Counter
End Sub

Kindly suggest me what I missed in this macro so that my program works well.

YowE3K
  • 23,852
  • 7
  • 26
  • 40
Jaffer Wilson
  • 7,029
  • 10
  • 62
  • 139

2 Answers2

2

This should work; using Like

Sub Macro1()

  With ActiveSheet
  For Counter = 1 To .Range("A:A").Count
    If .Range("A" & Counter).Value Like "*@*" Then

      .Range("A" & Counter).Cut .Range("B" & Counter)
      Application.CutCopyMode = False

    End If
  Next Counter
  End With

End Sub

You should avoid selecting/activating in VBA:

How to avoid using Select in Excel VBA macros

If you don't really want to loop over an entire column read this:

EXCEL VBA - Loop through cells in a column, if not empty, print cell value into another column

As posted as another answer, Find would be a good approach (faster) toward this problem.

M--
  • 25,431
  • 8
  • 61
  • 93
2

Rather then looking at every cell in column A just go straight to the cells with FIND.

Each time @ is found it will be moved to column B and the value in column A is removed. When there's no more to find the loop will stop.

Public Sub MoveToAdjactent()

    Dim MatchString As String
    Dim rFound As Range

    MatchString = "@"

    With ThisWorkbook.Worksheets("Sheet1").Columns(1)
        Set rFound = .Find(MatchString, LookIn:=xlValues, LookAt:=xlPart)
        If Not rFound Is Nothing Then
            Do
                rFound.Offset(, 1) = rFound
                rFound.ClearContents
                Set rFound = .FindNext(rFound)
            Loop While Not rFound Is Nothing
        End If
    End With

End Sub
Darren Bartrup-Cook
  • 18,362
  • 1
  • 23
  • 45