Results 1 to 2 of 2
  1. #1
    Lounger
    Join Date
    Jan 2014
    Posts
    30
    Thanks
    7
    Thanked 0 Times in 0 Posts

    Move entire contents of cell based on specific character

    Hi,

    I want to create a macro which will search Column A on sheet1 for the list of specific characters and if found, move the entire cell value into the same row in Column B. The list of specific characters to search is on sheet2.

    sheet1 column 'A'
    12 statement move to column 'B'
    ...some data
    ...some data
    ...some data
    13 stationery
    move to column 'B'
    ...some data
    ...some data
    ...some data
    ...some data
    23 ledger ......move to column 'B'
    ...some data
    ...some data
    33 old stock...move to column 'B'
    ...some data
    43 machine...
    move to column 'B'

    Sheet2 Column 'A' LIST
    1 order
    2 sales
    3 purchases
    4 returns
    12 statement
    13 stationery
    14 labor
    15 payable
    16 power
    17 output
    23 ledger
    24 export
    25 import
    26 customs
    27 wages
    28 carriage
    33 old stock
    34 printing
    35 bad debts
    36 audit
    43 machine
    44 rounded off
    45 rent
    46 premises

    Thanks in advance.


  2. #2
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,643
    Thanks
    115
    Thanked 652 Times in 594 Posts
    Hi john,

    Here is a short subroutine if you are willing to use vba. It cannot be in the form of a UDF or a formula as you want the term moved (deleted from col A)and a UDF nor a formula can manipulate data in another cell. On the second sheet, give the values to be sought a named range of rng.

    in a standard module
    Code:
    Public Sub FindTerms()
    Dim cell As Range
    Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    For I = 2 To Lastrow
        term = Cells(I, 1)
        For Each cell In Range("rng")
            If InStr(1, term, cell, vbTextCompare) > 0 Then
                Cells(I, 2) = term
                Cells(I, 1) = ""
            End If
        Next cell
    Next I
    End Sub
    Move Data.png
    Attached Files Attached Files
    Last edited by Maudibe; 2016-11-19 at 15:35.

  3. The Following User Says Thank You to Maudibe For This Useful Post:

    John_2014 (2016-11-21)

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •