[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 299
  • Last Modified:

Searct text file and copy all data found to a new sheet

Hi,

I have a text file which has such data
Dev-chen-pc2519
Dev-chen-pc1156
Dev-chen-pc651
Dev-chen-pc1730

What i want is a macro which can search the txt file and move all data found with the complete row to a new sheet.

Regards
Sharath
0
bsharath
Asked:
bsharath
1 Solution
 
MalicUKCommented:
Hi Sharath,

Just a note, but I've seen loads of your questions posed in the wrong main topic area.

Please post your Qs in the Excel TA as a main, and if you have to then crosslink them to other applicable TAs.

Cheers,
MalicUK.
0
 
bsharathAuthor Commented:
MalicUK

Ok sure malik.I think i need to check the topics before i post.

THX
Sharath
0
 
hiteshgoldeneyeCommented:
Sub amove()
Dim FF as Integer,s2row as Integer
s2row=1
 FF=FreeFile
 Open "C:\Filename.txt" for Input as #FF
While Not EOF(FF)
 Line Input #FF,str1

  For i=1 to Sheet1.UsedRange.Rows.Count
        if UCase(Sheet1.Cells(i,1) = UCase(str1) then
            Sheet1.Rows(i).Cut Destination:= Sheet2.Rows(s2row)
            s2row=s2row+1
       End if
 Next
Wend
Close FF
End Sub
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
bsharathAuthor Commented:
I get compile error here

if UCase(Sheet1.Cells(i,1) = UCase(str1) then
0
 
hiteshgoldeneyeCommented:
Sub amove()
Dim FF as Integer,s2row as Integer,str1 as String
s2row=1
 FF=FreeFile
 Open "C:\Filename.txt" for Input as #FF
While Not EOF(FF)
 Line Input #FF,str1

  For i=1 to Sheet1.UsedRange.Rows.Count
        if UCase(Sheet1.Cells(i,1).Value = UCase(str1) then
            Sheet1.Rows(i).Cut Destination:= Sheet2.Rows(s2row)
            s2row=s2row+1
       End if
 Next
Wend
Close FF
End Sub
0
 
bsharathAuthor Commented:
Same compiling error.

 if UCase(Sheet1.Cells(i,1).Value = UCase(str1) then
0
 
hiteshgoldeneyeCommented:
Sub amove()
Dim FF as Integer,s2row as Integer,str1 as String
s2row=1
 FF=FreeFile
 Open "C:\Filename.txt" for Input as #FF
While Not EOF(FF)
 Line Input #FF,str1

  For i=1 to Sheet1.UsedRange.Rows.Count
        if UCase(Sheet1.Cells(i,1).Value) = UCase(str1) then
            Sheet1.Rows(i).Cut Destination:= Sheet2.Rows(s2row)
            s2row=s2row+1
       End if
 Next
Wend
Close FF
End Sub

0
 
bsharathAuthor Commented:
Should it be in any specific colum.If yes can you chanfe the macro to search any part of the sheet.Please remove case sensivity but has to move all exact data found
0
 
bsharathAuthor Commented:
If possible please make the search specify.

Ex:
If i have 1230 in the txt file
In the excel i have 1230 and 123 then it should move only 1230 not 123
0
 
hiteshgoldeneyeCommented:

Sub amove()
Dim FF as Integer,s2row as Integer,str1 as String
s2row=1
 FF=FreeFile
 Open "C:\Filename.txt" for Input as #FF
While Not EOF(FF)
 Line Input #FF,str1

  For i=1 to Sheet1.UsedRange.Rows.Count
     For j=1 to Sheet1.usedRange.Columns.Count
        if Sheet1.Cells(i,j).Value = str1 then
            Sheet1.Rows(i).Cut Destination:= Sheet2.Rows(s2row)
            s2row=s2row+1
       End if
     Next
 Next
Wend
Close FF
End Sub
0
 
jeveristCommented:
Hi Sharath,

> it should move only 1230 not 123

Try this:

Sub MoveData()
Dim wb As Workbook, ws As Worksheet, ws_new As Worksheet, ws_txt As Worksheet
Dim fn As Variant, rng As Range, cel As Range, rg As Range, frg As Range, addr As String

Application.ScreenUpdating = False

Set ws = ActiveSheet
Worksheets.Add After:=Worksheets(Worksheets.Count)
Set ws_new = ActiveSheet

fn = Application.GetOpenFilename(FileFilter:="Text Files (*.txt), *.txt", Title:="Open Input File", MultiSelect:=False)

If fn = False Then
    MsgBox "No file selected.  Exiting routine.", vbInformation
    Exit Sub
End If
   
Set wb = Workbooks.Open(Filename:=fn, Format:=1) ' Tab delimited
Set ws_txt = ActiveSheet

Set rg = ws.UsedRange
Set rng = ws_txt.UsedRange.Columns(1)

For Each cel In rng.Cells
    Set frg = rg.Find(cel.Value, LookIn:=xlValues, LookAt:=xlWhole)
   
    If Not frg Is Nothing Then
        addr = frg.Address
        Do Until frg Is Nothing
            frg.EntireRow.Copy Destination:=ws_new.Cells(ws_new.Rows.Count, "A").End(xlUp).Offset(1)
            Set frg = rg.FindNext(After:=frg)
            If frg.Address = addr Then Exit Do
        Loop
    End If
Next cel

wb.Close SaveChanges:=False

If Application.CountA(ws_new.Rows(1)) = 0 Then ws_new.Rows(1).Delete

Application.ScreenUpdating = True

End Sub

Jim
0

Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now