Comparing column cell contents to a text file and copying matching rows to another workbook VBA - vba

Question

I have no idea what I am doing and if you feel like yelling at me that's cool.
I am wondering how I would go about checking values of each cell in column D on a worksheet called PriceList against values in a text file ItemNumber.txt.
If the content of the cells in the column is equal to one of the values in said text file I want it to copy the row and paste it into sheet1....
Option Explicit
Sub CompareValue()
Dim FileNum As Integer
Dim DataLine As String
Dim cel As Range
Dim celString As String
' Select file to be opened
FileNum = FreeFile()
Open "C:\Users\jreinhold\Documents\ItemNumbers.txt" For Input As #FileNum
Set myRange = Range("D:D")
For i = 1 To myRange.Rows.Count 'loop through rows by using i as a cell reference
Do While Not EOF(FileNum) 'run input from file while not end of file
Line Input #FileNum, DataLine 'input line data into DataLine
' Check value of cell against read in data
If InStr(DataLine, myRange.Cells("D", i).Value) = 0 Then 'compare DataLine to cell i
' Copy Row Where match resides
DataLine = DataLine + 1 'if value of comparison is 0 add 1 to data line and get next line in text file
Loop 'Loop back around and plus next line for the data from the file in and check values against cell i again
End If 'end If once value for comparison is true
Source.Rows(c.Row).Copy Target.Rows(i) ' Copy row
Sheets("Sheet1").Paste ' Paste row into Sheet1
i = i + 1 ' add 1 to i in order to continue to next cell in column
Next i 'check next cell for the data inputs using the same code.
Wend
End Sub

Answer 1

Try this:
Sub CompareValue()
Dim mainWS As Worksheet, dataWS As Worksheet, txtWS As Worksheet
Dim FileNum&, i&, j&
Dim DataLine As String, celString$
Dim cel As Range, myRange As Range
Dim ranOnce As Boolean
ranOnce = False ' Check if we've added a line to your new sheet
Dim fileName$, filePath$, fullFile$
filePath = "C:\Users\bWayne\"
fileName = "myTextDoc.txt"
fullFile = filePath & fileName
Set dataWS = Sheets("Data") ' Rename this, this sheet has your column D with the values to check
Set mainWS = Sheets("Sheet1") ' This is where the row from DATA will be copied to, if a match is found in the text file.
' This will call a sub that will put the text into the temp sheet
TextFile_PullData fullFile, mainWS
Set txtWS = Sheets(Left(fileName, WorksheetFunction.Search(".", fileName) - 1))
' Now we have the text file informaiton in a sheet. So just loop through the cells in "Data" and check if there's a match in the text
Dim lastRow&
lastRow = dataWS.Cells(dataWS.Rows.Count, 4).End(xlUp).Row
Set myRange = dataWS.Range("D1:D" & lastRow) ' edit this as necessary
For Each cel In myRange
If WorksheetFunction.CountIf(txtWS.Range("A1:A" & txtWS.UsedRange.Rows.Count), cel.Value) > 0 Then
' Since we found a match, copy the entire row to "Sheet1"
Dim newLastRow&
newLastRow = mainWS.Cells(mainWS.Rows.Count, 4).End(xlUp).Row
If ranOnce Then newLastRow = newLastRow + 1
ranOnce = True
mainWS.Rows(newLastRow).EntireRow.Value = cel.EntireRow.Value
End If
Next cel
End Sub
Sub TextFile_PullData(fileName As String, mySheet As Worksheet)
Workbooks.OpenText fileName:=fileName, _
Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
TrailingMinusNumbers:=True
ActiveSheet.Copy after:=mySheet
End Sub
Instead of going line by line, I just imported the Text file into Excel, and am just doing a CountIf() to see if there's a match. If so, copy that row to your new sheet. Please note you will probably want to change the Sheets, as it's not clear to me where you want the data to go. This should help get you going though! I recommend stepping through with F8 just to make sure it works.
Edit: You had some loops in there that I may have not considered, so let me know if I'm missing something.