Coping values to another workbook if matching text is found

Question

The following code opens a .csv file, finds “Trimmed Mean” in col B, uses the row of “Trimmed Mean” as the starting point to find the next “NC” value in column B and copies value one cell to the right of “NC” to the Workbook from which the code is executed (Sheet 1 col A).

The problem is that the code runs but the value is not copied to the sheet1. It’s probably just a minor thing but I can’t figure out what that is. Thanks for your help.

Const delim = vbTab  'for TAB delimited text files


Sub ImportMultipleTextFiles()

Dim wb As Workbook
Dim sFile As Variant
Dim LastRow As Long
Dim rngCell As Range
Dim varMyItem As String

varMyItem = "NC"

sFile = Application.GetOpenFilename("Text Files (*.csv),*.csv", , "Please select text file...")

Set wb = Workbooks.Open(Filename:=sFile)

Application.ScreenUpdating = False

wb.Sheets(1).Select

LastRow = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row
Debug.Print "LastRow = " & LastRow

Set aCell = ActiveSheet.Range("B1:B" & LastRow).Find(What:="Trimmed Mean", LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)

Debug.Print "Trimmed Mean can be found in Row # " & aCell.Row
'wb.Sheets(1).Select

For Each rngCell In ActiveSheet.Range("B" & aCell.Row & ":B" & LastRow)
' Debug.Print ActiveSheet.Range("B" & aCell.Row & ":B" & LastRow)
    If InStr(rngCell, "NC") > 0 Then
        Debug.Print rngCell.Row
'
        rngCell.Offset(0, 1).Copy Destination:=ThisWorkbook.ActiveSheet.Range("A" & ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row + 1)

        Exit For
    End If
Next rngCell


wb.Close SaveChanges:=False

Set wb = Nothing

Application.ScreenUpdating = True

End Sub

stay **away** from `Select` and `ActiveSheet` in your code as much as possible (see [this](http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros)). Qualify all your `Workbooks / Sheets / Ranges` and your code will most likely run as smooth as you desire. This line, in particular, is a real problem: `ThisWorkbook.ActiveSheet.Range("A" & ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row + 1)` — Scott Holtzman, Jan 13 '16 at 18:02

score 0 · Accepted Answer · answered Jan 13 '16 at 18:13

Read my comment above and review the link I sent.

I have edited your code to qualify all your objects and work directly with each intended object. In this way you can be sure that your code will act on the exact object you desire every-time.

You can define the lines I edited, by the '*** at the line's end.

Const delim = vbTab  'for TAB delimited text files

Sub ImportMultipleTextFiles()

Dim wb As Workbook, wbThis As Workbook '***
Dim wsCopy As Worksheet, wsPaste As Worksheet '***
Dim sFile As Variant
Dim LastRow As Long
Dim rngCell As Range
Dim varMyItem As String

Set wbThis = ThisWorkbook '***
Set wsPaste = wbThis.Sheets("Sheet1") 'change name as needed '***

varMyItem = "NC"

sFile = Application.GetOpenFilename("Text Files (*.csv),*.csv", , "Please select text file...")

Set wb = Workbooks.Open(Filename:=sFile)
Set wsCopy = wb.Sheets(1) '***

Application.ScreenUpdating = False

LastRow = wsCopy.Range("B" & Rows.Count).End(xlUp).Row '***
Debug.Print "LastRow = " & LastRow

Set aCell = wsCopy.Range("B1:B" & LastRow).Find(What:="Trimmed Mean", LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False) '***

Debug.Print "Trimmed Mean can be found in Row # " & aCell.Row
'wb.Sheets(1).Select '***

For Each rngCell In wsCopy.Range("B" & aCell.Row & ":B" & LastRow) '***
' Debug.Print ActiveSheet.Range("B" & aCell.Row & ":B" & LastRow)
    If InStr(rngCell, "NC") > 0 Then
        Debug.Print rngCell.Row
'
        rngCell.Offset(0, 1).Copy Destination:=wsPaste.Range("A" & wsPaste.Range("A" & wsPaste.Rows.Count).End(xlUp).Row + 1) '***

        Exit For
    End If
Next rngCell


wb.Close SaveChanges:=False

Set wb = Nothing

Application.ScreenUpdating = True

End Sub

Coping values to another workbook if matching text is found

1 Answers1