CODEWITHSUNDEEP
vbaexcel
Jeremy Reinhold
Jeremy Reinhold

Reputation: 3

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

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

Upvotes: 0

Views: 2308

Answers (1)

BruceWayne
BruceWayne

Reputation: 23285

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.

Upvotes: 0

Related Questions