VBA : Find a string in Sheet1/ColA, move that whole row to Sheet2 (with a loop to do a large amount at once)

[ExcelJohn]

Hi Excel Users!

I have a UserForm with a TextBox and two buttons.

You insert a text string in the textbox, click the button, and this is what it does :

It finds the string in the A column of Sheet1.
It copies the whole row containing the matched string from Sheet1 to Sheet2.
It deletes the whole row from Sheet1.

Result : Cut from Sheet1 and paste to Sheet2
See the code at the end of the post.

I would like to know how to adapt that code to use a multiline TextBox, so I can do the same procedure for a large amount of strings (one per line). I know how to tweak the properties of the textbox to make it multiline, but I don't know how to turn the code into a loop that does the same, one by one, to all of them. I am going to paste a large amount of strings (~500) so it has to be ready for that.

Private Sub CommandButton1_Click()
    Dim myString As String
    Dim foundCell As Range
    
    myString = Trim(UserForm2.TextBox1.Value)
    If myString = vbNullString Then
        Exit Sub
    End If
    
    On Error GoTo ErrorOut
    
        ' Find and copy entire row.
        With Sheets("Sheet1").Range("A:A")
            Set foundCell = .Find(What:=myString, After:=.Cells(1, 1), LookAt:=xlWhole)
            foundCell.EntireRow.Copy
        End With
    
        ' Paste copied cell.
        Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial
    
        ' Delete entire row of found range.
        foundCell.EntireRow.Delete
        
        UserForm2.Label2.Caption = "Record " & myString & " moved from Sheet1 to Sheet2"
        Exit Sub
        
ErrorOut:
    UserForm2.Label2.Caption = "Record " & myString & " doesn't exist in Sheet1 col A"
    On Error GoTo 0
End Sub

I would be very gald if someone could give me a hand.

Thanks!

 

[Comfy]

Thanks Comfy, this works!!!

How many rows do you think this code will support ? I am expecting the user entrying batches of ~500-1000 entries at the same time.

No idea you could mock up a sheet of 1000 enteries and see.

Also in testing the split etc etc

EnterKeyBehaviour of the textbox properties was set to True.

This will allow the user to use just Enter rather than Ctrl+Enter

 

[ExcelJohn]

I found using a textbox has a few problems.
This method basically works.
If you make the textbox the width of a single entry and make it multiline and each entry is seperated by a space, then the entries will show as a column of data, which is what you want.

If you enter the data single then press "Ctrl + Return" to place the entries in a column, then the data "Seperator" appears to be a space "Chr(32)" and a Return "Chr(13)" , you then have the problem of removing/splitting them to get a match with your data , which sound easier than it is !!

How do you intend to load your data, perhaps you have a better method ????

Hi Mick!

I am not sure I understand your answer, sorry, I am a very newbie with VBA ... :-|

I have tried the Comfy proposed change over your last code and it works perfect with a multiline TextBox (multiline=true enterkeybehaviour=true)

The data will be loaded from a column in another excel file. Each row of this other file will have a string, so the user will copy for example, let's say the first 500 rows, then open the real excel file (the one i'm putting this code), click on a button, the UserForm will popup with the multiline textbox, and then he will press a button and the code you provided me with Comfy modification will be run.

I've tried this and it works. Do you thing is it dangerous like that ? Or that there might be some caveats ?

Thanks again man.

 

[MickG]

I should go with "Comfy", sounds like his idea works well.
Regards Mick

 

[ExcelJohn]

I should go with "Comfy", sounds like his idea works well.
Regards Mick

Great!

And is it possible to make the code don't stop if it founds a non existing string ?

This is because if the user inserts for instance 300 lines and the line 80 contains a non existing string, then it stops, runs this :

ErrorOut:
    Me.Label1.Caption = "Record " & myString(Pst) & " doesn't exist in Sheet1 col A"
    On Error GoTo 0

and doesn't process the rest.

 

[MickG]

Try something like this:-

Private [COLOR="Navy"]Sub[/COLOR] CommandButton1_Click()
    [COLOR="Navy"]Dim[/COLOR] myString [COLOR="Navy"]As[/COLOR] Variant
    [COLOR="Navy"]Dim[/COLOR] foundCell [COLOR="Navy"]As[/COLOR] Range
    [COLOR="Navy"]Dim[/COLOR] Pst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
    [COLOR="Navy"]Dim[/COLOR] Msg1 [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
    [COLOR="Navy"]Dim[/COLOR] Msg2 [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
 Application.ScreenUpdating = False
    myString = Split(Replace(Me.TextBox1.Value, vbCrLf, " "), " ")
    [COLOR="Navy"]For[/COLOR] Pst = 0 To UBound(myString)
      [COLOR="Navy"]If[/COLOR] myString(Pst) = vbNullString [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]Exit[/COLOR] [COLOR="Navy"]Sub[/COLOR]
    [COLOR="Navy"]End[/COLOR] If
    
    [COLOR="Navy"]With[/COLOR] Sheets("Sheet10").Range("A:A")
            [COLOR="Navy"]Set[/COLOR] foundCell = .Find(What:=myString(Pst), After:=.Cells(1, 1), LookAt:=xlWhole)
            [COLOR="Navy"]If[/COLOR] Not foundCell [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
                foundCell.EntireRow.Copy
                Msg1 = Msg1 & myString(Pst) & Chr(10)
                    '[COLOR="Green"][B] Paste copied cell.[/B][/COLOR]
                Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial
                    '[COLOR="Green"][B] Delete entire row of found range.[/B][/COLOR]
                foundCell.EntireRow.Delete
            [COLOR="Navy"]Else[/COLOR]
               Msg2 = Msg2 & myString(Pst) & Chr(10)
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]End[/COLOR] With
     [COLOR="Navy"]Next[/COLOR] Pst
    
Me.Label1.Caption = "Data Copied :-" & Chr(10) & Msg1 & Chr(10) & "Data Not Found :-" & Chr(10) & Msg2
  Application.ScreenUpdating = True
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[ExcelJohn]

GREAT MICK!!! Thanks again!!!