Macro to delete ROWS in a spreadsheet using Text file

[Argus Rogue]

I have a spreadsheet that has up to 10 columns and xx amount of rows
example below.

Unique LName FName City State Zip Phone SpouseName Child1 Child2
----------------------------------------------------------------------------------------------
TheJones Jones John Lincoln NB 12345 123-4567 Jane jOe Jerry
TheBrowns Brown James Austin TX 14782 231-4789 Beth James Linda
TheAdams Adams Benny Dallas TX 78965 321-9874 Robin Eddie Alex


Now, I have a seperate text file that just has the UniqueName in it.


TheBrowns


What I want to do is the following:
1. Use the UniqueName in the text file to to delete all rows of data
that does not match via the Uniquename in the spreadsheet.

2. So the result of the above should be the following:

UniqueName LName FName City State Zip Phone SpouseName Child1 Child2
----------------------------------------------------------------------------------------------
TheBrowns Brown James Austin TX 14782 231-4789 Beth James Linda


Is this possible to do with a Excel Macro. Any and all help in this matter
would be greatly appreciated.

 

[Nigel]

Some code for you to adapt, I assumed the following

1. Data is on a Sheet named Sheet1 if not change the line: With
Sheets("Sheet1") to suit
2. Data starts in Row1, if you have a header row then change line: lLastRow
To 2 Step -1
3. Your name string is in column A if not then change the code in two places
where you see "A" to suit
4. The Text you are reading is in a file "D:\ExcelTest.txt", change as
needed. The first line of text will be used to scan the list.

Sub RemoveRows()
Dim sName As String, lLastRow As Long, lRow As Long

' read text line for external file
Open "D:\ExcelTest.txt" For Input As #1
Input #1, sName
Close #1

' scan all rows and delete if not matching
With Sheets("Sheet1")
lLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For lRow = lLastRow To 1 Step -1
If Trim(.Cells(lRow, "A")) <> Trim(sName) Then .Rows(lRow).Delete
shift:=xlUp
Next
End With

End Sub

 

[Argus Rogue]

Nigel,

As per your code example, everything worked with one exception, Line 4.
Well actually, Line 4 did work but it only did the first line of text. If I
have more than one line of text in my text file, how can I use the whole
list.

Argus

 

[Nigel]

I picked up your OP that said 'Now, I have a separate text file that just
has the Unique Name in it', if your text file has multiple lines, then the
approach is similar but requires some changes, (code below is untested).

1. Read each row of text and store into an array.
2. As you scan your Excel list loop thru the array checking each value for a
possible match

'==================================
' read multiple lines into array
'==================================
Dim sNames() As String, sName as string, iCount as Integer
iCount = 0
Open "D:\ExcelTest.txt" For Input As #1
While Not EOF(1)
iCount = iCount + 1
ReDim Preserve sNames(1 to iCount)
Input #1, sName
sNames(iCount) = Trim(sName)
Wend
Close #1
'==================================

The inner loop to read the array, takes the following form, however since
any name could match we cannot directly remove the row if it does not match,
so set a boolean value to indicate if there is a match. The first match
means we can drop out of the loop, there is no need to check the rest of the
array. Finally if the name does not match any value delete the row.

'==================================
' inner loop
'==================================
Dim bNotFound as Boolean
bNotFound = True
For iCount = LBound(sNames) to UBound(sNames)
If Trim(.Cells(lRow, "A")) = sNames(iCount) then
bNotFound = True
Exit For
End If
Next

' remove the row if no match found
If bNotFound then .Rows(lRow).Delete shift:=xlUp
' end of inner loop
'==================================

Put the above inner loop code between the original code, replacing the
original match/delete code

For lRow = lLastRow To 1 Step -1

' inner loop code here

Next

HTH


--

Regards,
Nigel
(e-mail address removed)

 

[Argus Rogue]

Nigel,

Sorry for the confusion on my original post. I meant to say that I had a
text file that had a list of the Unique names in it.

Your original code that you provided works like a charm. It did delete
every row that did not match from the text file that had the unique name in
it. I also liked how the screen flickered for a few second and then only
showed the remaining row that matched.

In your updated code below, I do not know if it is working. All I get now
is just an hour glass from the cursor on the screen. I let it run for 10-15
minutes with no results. Listed below is the code that you provided with
the modification per your instructions.

Did I do it wrong?

Sub RemoveRows()
Dim sNames() As String, sName As String, iCount As Integer

iCount = 0
Open "C:\Temp\ExcelTest.txt" For Input As #1
While Not EOF(1)
iCount = iCount + 1
ReDim Preserve sNames(1 To iCount)
Input #1, sName
sNames(iCount) = Trim(sName)
Wend
Close #1

' scan all rows and delete if not matching
With Sheets("Sheet1")
lLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For lRow = lLastRow To 2 Step -1
Dim bNotFound As Boolean
bNotFound = True
For iCount = LBound(sNames) To UBound(sNames)
If Trim(.Cells(lRow, "A")) = sNames(iCount) Then
bNotFound = True
Exit For
End If
Next

' remove the row if no match found
If bNotFound Then .Rows(lRow).Delete shift:=xlUp
Next
End With

End Sub

Your assistance is greatly appreciated.

Argus

 

[Nigel]

Argus
Apologies I have now tested my code, the bNotFound should have been set
False not True after the test. Highlighted below. It now works for me OK.


Sub RemoveRows()
Dim sNames() As String, sName As String, iCount As Integer
Dim lLastRow As Long, bNotFound As Boolean, lRow As Long

iCount = 0
Open "C:\ExcelTest.txt" For Input As #1
While Not EOF(1)
iCount = iCount + 1
ReDim Preserve sNames(1 To iCount)
Input #1, sName
sNames(iCount) = Trim(sName)
Wend
Close #1

' scan all rows and delete if not matching
With Sheets("Sheet1")
lLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For lRow = lLastRow To 2 Step -1
bNotFound = True
For iCount = LBound(sNames) To UBound(sNames)
If Trim(.Cells(lRow, "A")) = sNames(iCount) Then
bNotFound = False ' <<< THIS LINE CORRECTED
Exit For
End If
Next

' remove the row if no match found
If bNotFound Then .Rows(lRow).Delete shift:=xlUp
Next
End With

End Sub

--

Regards,
Nigel
(e-mail address removed)

 

[Argus Rogue]

Nigel,

No apologies needed. You code works great. thanks for all the help.
Very much appreciated.

Argus