?
Solved

move all rows containing key word in excel to new work sheet

Posted on 2007-07-19
12
Medium Priority
?
196 Views
Last Modified: 2010-04-16
I want to move all rows contaning a key word or words to a new work sheet.
here is some code i wrote to delete all rows containg a key word in column 2
or better yet if i could pass it the name of the word in an imput box and also list the column number in an imput box

any help would be appriciated.

Sub test()
     
    Dim ws As Worksheet
    Dim end_row, r As Integer

    For Each ws In Worksheets
        If ws.Name <> " test"
            end_row = ws.Cells(65536, 25).End(xlUp).Row
            For r = end_row To 1 Step -1
                If Cells(r, 2).Value = "anonymous" Then
                    Rows(r).EntireRow.Delete              
                End If
            Next
      End If
    Next
End Sub
0
Comment
Question by:ZJY0021
  • 6
  • 6
12 Comments
 
LVL 19

Expert Comment

by:david251
ID: 19524998
Try this, just change your sheet names and your done:

Sub subFindandCopy()
    Dim c As Range
    Dim strColumn As String
    Dim strFind As String
    strColumn = InputBox("Type a column letter")
    strFind = InputBox("Enter a search criteria")
    With Worksheets("Sheet1").Range(strColumn & ":" & strColumn)
    Set c = .Find(strFind, LookIn:=xlValues, lookat:=xlPart)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            c.EntireRow.Copy Worksheets("Sheet2").Range("a65000").End(xlUp).Offset(1, 0)
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
    End With

End Sub

-David251
0
 

Author Comment

by:ZJY0021
ID: 19525057
sweet works but does not delet from first sheet

thanks
0
 
LVL 19

Expert Comment

by:david251
ID: 19525080
Sub subFindandCopyandDelete()
    Dim c As Range
    Dim strColumn As String
    Dim strFind As String
    strColumn = InputBox("Type a column letter")
    strFind = InputBox("Enter a search criteria")
    With Worksheets("Sheet1").Range(strColumn & ":" & strColumn)
    Set c = .Find(strFind, LookIn:=xlValues, lookat:=xlPart)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            c.EntireRow.Copy Worksheets("Sheet2").Range("a65000").End(xlUp).Offset(1, 0)
            c.EntireRow.Delete
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
    End With

End Sub

-David251
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 

Author Comment

by:ZJY0021
ID: 19525275
it is not looping
it will copy and delete the first string ie "test"
but then will bomb

the first code works as designed
0
 
LVL 19

Expert Comment

by:david251
ID: 19525299
Sorry, I forgot it needs c in the next iteration, try this:

Sub subFindandCopyandDelete()
    Dim c As Range, d as Range
    Dim strColumn As String
    Dim strFind As String
    strColumn = InputBox("Type a column letter")
    strFind = InputBox("Enter a search criteria")
    With Worksheets("Sheet1").Range(strColumn & ":" & strColumn)
    Set c = .Find(strFind, LookIn:=xlValues, lookat:=xlPart)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            c.EntireRow.Copy Worksheets("Sheet2").Range("a65000").End(xlUp).Offset(1, 0)
            set d=c
            Set c = .FindNext(c)
            d.EntireRow.Delete
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
    End With

End Sub
0
 

Author Comment

by:ZJY0021
ID: 19525317
it is still only doing one row
one copy an one delete but no errors :)
0
 

Author Comment

by:ZJY0021
ID: 19525462
Ok i made a function to go along with your code and that seems to work but i need some help on it now

Here it is

Public Function delete()

     
    Dim ws As Worksheet
    Dim end_row, r As Integer

    For Each ws In Worksheets
        If ws.Name <> " sheet1" Then
            end_row = ws.Cells(65536, 25).End(xlUp).Row
            For r = end_row To 1 Step -1
                If Cells(r, 2).Value = strFind Then  I NEED IT TO PULL THE COLUM LETTER FROM THE IMPUT  BOX LIKE I HAVE IT FOR THE TEXT
                    Rows(r).EntireRow.delete              
                End If
            Next
      End If
     
    Next


End Function
0
 
LVL 19

Accepted Solution

by:
david251 earned 2000 total points
ID: 19525497
This will work for you.

Sub subFindandCopyandDelete()
    Dim c As Range, d As Range
    Dim strColumn As String
    Dim strFind As String
    strColumn = InputBox("Type a column letter")
    strFind = InputBox("Enter a search criteria")
    With Worksheets("Sheet1").Range(strColumn & ":" & strColumn)
    Set c = .Find(strFind, LookIn:=xlValues, lookat:=xlPart)
    If Not c Is Nothing Then
        Do
            On Error GoTo enditnow
            c.EntireRow.Copy Worksheets("Sheet2").Range("a65000").End(xlUp).Offset(1, 0)
            Set d = c
            Set c = .FindNext(c)
            d.EntireRow.Delete
        Loop While Not c Is Nothing
    End If
    End With
enditnow:
   
End Sub
0
 

Author Comment

by:ZJY0021
ID: 19525600
your a life saver thank you
0
 
LVL 19

Expert Comment

by:david251
ID: 19525613

Glad I could help:-)
Thanks for the points/grade.
-David251
0
 

Author Comment

by:ZJY0021
ID: 19525632
no problem i think i got it now
i will post another question so you can get some more points
because say the word i want to copy and delete is test it will copy and delete test1 test\company anything that has test in it so is there a way to make it match exact?
0
 
LVL 19

Expert Comment

by:david251
ID: 19525645
change this:
Set c = .Find(strFind, LookIn:=xlValues, lookat:=xlPart)
to this
Set c = .Find(strFind, LookIn:=xlValues, lookat:=xlWhole)

No need to post another question
0

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

In threads here at EE, each comment has a unique Identifier (ID). It is easy to get the full path for an ID via the right-click context menu. However, we often want to post a short link within a thread rather than the full link. This article shows a…
Measuring Server's processing rate with a simple powershell command. The differences in processing rate also was recorded in different use-cases, when a server in free and busy states.
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.
Suggested Courses

612 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question