Retain a data value and remove other cell contents.

Astronaut01

New Member
Joined
Jan 26, 2022
Messages
18
Office Version
  1. 2016
Platform
  1. Windows
Hello excel vba experts
Im quite new to excel vba and need to create a vba tool that can:
1. Search for all data value/s that has the "RTN000..." in column F. Some cells in column F has mulitple "RTNs..." and symbols and words.
2. Once found, it should copy that specific "RTN" together with all the row data, to a sheet i named Output.

Been trying to see if a use of wildcard would work but not sure how. Many thanks in advance for all your solutions.
 
VBA Code:
Private Sub CommandButton1_Click()
     Dim MyRTN, Arr6

     Set Sheet1sh = ThisWorkbook.Sheets("Sheet1")
     Set findapsh = ThisWorkbook.Sheets("findap")
     Set outputsh = ThisWorkbook.Sheets("output")

     outputsh.UsedRange.Clear                                   'clear output-sheet

     With findapsh
          MyRTN = Application.Transpose(.Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row).Value)     'array with the wanted RTN's
     End With

     With Sheet1sh
          .AutoFilterMode = False                               'disable autofilter
          Set c = .Range("A1").CurrentRegion                    'range on with autofilter 'll be applied

     '*****1st option *******EXACT **********************************************
     'copy those rows, with an exact match !!!!
          c.AutoFilter 6, MyRTN, Operator:=xlFilterValues       'filter on that array
          c.Copy outputsh.Range("O1")                           'copy to output-sheet
     '***********************************************************************

     '*****2nd option ******CONTAIN **********************************************
     'you asked, cells that contain those RTN's, so extra check to collect all those in an array !!!!!
          Arr6 = Application.Transpose(c.Offset(1, 5).Resize(c.Rows.Count - 1, 1).Value)     'array of the databodyrange, 6th column
          For i = 1 To UBound(MyRTN)                            'loop through all wanted RTN's
               fl = Filter(Arr6, MyRTN(i), 1, vbTextCompare)    'all entries of the array that contain that RTN
               If UBound(fl) <> -1 Then s = s & "|" & Join(fl, "|")     'join them, with "|" as separator in a string
          Next
          vs = Split(Mid(s, 2), "|")                            'split the gathered entries on the "|"
          c.AutoFilter 6, vs, Operator:=xlFilterValues          'filter on that array
          c.Copy outputsh.Range("A1")                           'copy to output-sheet
     '***********************************************************************
          c.AutoFilter
     End With

     MsgBox ("Search result copied to output sheet.")
End Sub
 
Upvote 0

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.

Forum statistics

Threads
1,214,593
Messages
6,120,434
Members
448,961
Latest member
nzskater

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top