CODEWITHSUNDEEP
vbaexcel
user3705931
user3705931

Reputation: 3

How to remain selected word form excel, and remove the rest

I need to deal with 14K rows of data within Excel.
I have a list of word need to be remain, and need to delete the rest. Due to large amount of data, it's to hard to find and replace the word one by one. I get some idea about put word list into another excel file and load it to check each column of data file(same as excel). Is vba my correct approach or can this be solved using Excel out of the box?

Upvotes: 0

Views: 877

Answers (1)

natancodes
natancodes

Reputation: 1008

This should get you started!

Sub CutWords() 'Cuts specific strings out from a specified sheet.

'---Variables---
Dim pos As Integer
Dim val As String
Dim word As String
Dim source As Worksheet
Dim target As Worksheet
Dim list As Worksheet
Dim startRow As Integer
Dim columns As Integer
Dim i As Long
Dim j As Long
Dim k As Long
Dim l As Long


'---Customize---
Set source = ThisWorkbook.Sheets(1) 'This sheet contains the data
Set target = ThisWorkbook.Sheets(2) 'Trimmed data will end up here
Set list = ThisWorkbook.Sheets(3)   'List of words to look for
startRow = 2                        'The first row to be trimmed in data
columns = 2                         'The number of columns to be trimmed in data


'---Logic---
Application.ScreenUpdating = False 'Saves us a bit of time
target.Cells.ClearContents 'Clearing the target sheet

i = startRow 'i will act as the "row counter" for our source sheet
l = 1 'l will act as the "row counter" for our target sheet

Do While i <= source.Range("A" & source.Rows.Count).End(xlUp).Row 'Looping until
'we hit the last row with data in "A" column.
    j = 1 'j will act as the "column counter" for our source sheet

    Do While j <= columns 'Checking all columns
        k = 1 'k will act as the "row counter" for our word list sheet

        Do While k <= list.Range("A" & list.Rows.Count).End(xlUp).Row 'Looping
        'until we hit the last row with data in "A" column - these are the words
            word = list.Range("A" & k).Value 'Get the word.
            val = source.Cells(i, j).Value 'Get the value to check.
            pos = InStr(val, word) 'Check for match, 0 = no match

            If pos > 0 Then 'Match found
                target.Cells(l, j).Value = val 'The values will be in the same
                'position as they were in the source (minus the ignored rows).

                'It should be quite simple to remove the empty space if needed.

            End If
            k = k + 1 'Next word

        Loop
        j = j + 1 'Next column

    Loop
    l = l + 1 'Next target row
    i = i + 1 'Next source row

Loop
Application.ScreenUpdating = True 'Make sure to restore the value

End Sub

Insert the code in a new code module and it should be ready to go, though I admit that I didn't do too much testing. Certainly not the fastest or fanciest approach - but a simple one.

EDIT: Even partial matches will be seen as matches. Your word in the word list could be "Hello" and a phrase like "Hello World!" would still be considered a match. If you'd like to have exact matches only, you'll need to compare the string directly instead of using InStr.

If val = word Then 'Match found

By default, the first sheet should contain your data, starting from column "A". It may have headers. The second sheet will be where the cut list goes after you run the macro. The third sheet will have the list of words you want to cut. The words must be in column "A".

HTH

Upvotes: 1

Related Questions