Solved VB code to search and copy row

April 24, 2013 at 08:35:22
Specs: Windows 7
Hi, DerbyDad03
I'm wondering if you can help me with the following task using vba code in excel;
in sheet1 I have a 40k+ rows of data with columns like
ID Rate Unit
TNT $1.2 10
PTN $5.2 12
TNT $1.8 50
MNC $2.5 30
I need to create a input box to enter ID and want to copy the whole row of data into sheet2. eg. i want to enter TNT in the input box, and row 1 and 3 are copied to sheet2.
Really appreciate your help!!

See More: VB code to search and copy row

Report •


✔ Best Answer
April 25, 2013 at 13:12:03
"Cells(i, 36).Select" Needs to be the way it was before you changed it. You were right to change the "If .Cells(i, 36) = FindString Then" line so you can leave it, but change the second line back to:

Cells(i, 1).Select

The reason is it sets the cell selector at the begining of the row that matches ID's so the next line can hightlight everything.

Try that and let me know.



#1
April 24, 2013 at 10:42:12
Will the copied values replace the existing values in Sheet2 or will they be appended to the bottom of the existing list.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#2
April 24, 2013 at 12:05:10
Thanks for your lightning response. Everytime when the new ID is entered in the input box, it shows only the newly copied list and sorted by Rate (low to high). Thanks!!!!

Report •

#3
April 24, 2013 at 13:23:54
The Code I'm posting does what I think you want. It creates a new sheet for each seperate search you do. Let me know if you need any changes made. As always, I would love any feedback DerbyDad03!

Sub FindInventory()
    Dim NewSheet
    Dim i As Long
    Dim NSheetName As String
    Dim FindString As String
    Dim Rng As Range
    FindString = InputBox("Please Enter full text of value you want to find", "You Must Enter something!")
        If Trim(FindString) = "" Then
                MsgBox "You did not enter something. Lookup cancled."
                Exit Sub
            Else
        End If
    NSheetName = FindString & " " & "Report"
    Set NewSheet = Sheets.Add(After:=Sheets(Worksheets.Count), Count:=1, Type:=xlWorksheet)
    NewSheet.Name = NSheetName
    ActiveCell = "ID"
    ActiveCell.Offset(0, 1).Select
    ActiveCell = "Rate"
    ActiveCell.Offset(0, 1).Select
    ActiveCell = "Unit"
    Cells(2, 1).Select
    Sheets("Sheet1").Select
    i = 1
    With ActiveSheet
            Do While i <= .Rows.Count
                If .Cells(i, 1) = FindString Then
                    Cells(i, 1).Select
                    Range(ActiveCell, ActiveCell.Offset(0, 2)).Copy
                        Sheets(NSheetName).Select
                        ActiveSheet.Paste
                        ActiveCell.Offset(1, 0).Select
                    Sheets("Sheet1").Select
                    
                ElseIf .Cells(i, 1) = "" Then
                    Exit Do
                End If
                i = i + 1
            Loop
        End With
 End Sub


Report •

Related Solutions

#4
April 24, 2013 at 14:17:57
Thank you! I tried the code - it created the new sheet, but didn't copy the rows. Any ideas?

Report •

#5
April 24, 2013 at 14:24:45
When you type in the search box, you need to match the case of the ID that you're looking for. If it's in all caps, like "TNT" then you need to type "TNT" into the search box.

One other thing I forgot in my code is to have it remove a tab if it is a duplicate. I will post a revision as soon as I can. I've been pretty busy today so it could be tomorrow. To get around this problem, just delete the tab that was created when you're done with it.


Report •

#6
April 24, 2013 at 14:28:23
Nevermind, it was an easy fix. Here's the updated code:

Sub FindInventory()
    Dim NewSheet
    Dim i As Long
    Dim NSheetName As String
    Dim FindString As String
    Dim Rng As Range
    FindString = InputBox("Please Enter full text of value you want to find", "You Must Enter something!")
        If Trim(FindString) = "" Then
                MsgBox "You did not enter something. Lookup cancled."
                Exit Sub
            Else
        End If
    NSheetName = FindString & " " & "Report"
    Application.DisplayAlerts = False
    On Error Resume Next
    Sheets(NSheetName).Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    Set NewSheet = Sheets.Add(After:=Sheets(Worksheets.Count), Count:=1, Type:=xlWorksheet)
    NewSheet.Name = NSheetName
    ActiveCell = "ID"
    ActiveCell.Offset(0, 1).Select
    ActiveCell = "Rate"
    ActiveCell.Offset(0, 1).Select
    ActiveCell = "Unit"
    Cells(2, 1).Select
    Sheets("Sheet1").Select
    i = 1
    With ActiveSheet
            Do While i <= .Rows.Count
                If .Cells(i, 1) = FindString Then
                    Cells(i, 1).Select
                    Range(ActiveCell, ActiveCell.Offset(0, 2)).Copy
                        Sheets(NSheetName).Select
                        ActiveSheet.Paste
                        ActiveCell.Offset(1, 0).Select
                    Sheets("Sheet1").Select
                    
                ElseIf .Cells(i, 1) = "" Then
                    Exit Do
                End If
                i = i + 1
            Loop
        End With
 End Sub


Report •

#7
April 24, 2013 at 19:44:01
Newbie10:

I'm not at a machine where I can write any code at the moment, so I'll just offer some general feedback based on what I see.

1 - I believe I've mentioned this before: You don't have to Select objects in VBA in order to perform an operation them. Your code will be much more efficient if you learn to eliminate all of the Select instructions.

This...

ActiveCell.Offset(0, 1).Select
    ActiveCell = "Rate"

...can be written as:

ActiveCell.Offset(0, 1) = "Rate"

Rarely, if ever, do you need to Select a Sheet or a Range or a Cell. Look back at all the code that I have written in this forum. You'd be hard pressed to find many situations where I used a Select instruction.

2 - You should consider using the Application.InputBox method instead of the InputBox function. The Application.InputBox method is much more powerful, allowing for the use of the Cancel button and other means to verify the user input. See here:

http://msdn.microsoft.com/en-us/lib...

e.g. You can check for the Cancel button by checking if the input is False:

' Get input from user
 myInput = Application.InputBox("Enter a value")
' Exit Sub if user clicks Cancel
   If myInput = False Then Exit Sub

3 - Using Find and FindNext is much more efficient than a Do-While loop. Looping through every cell (and actually Selecting them!) is one of the most inefficient ways to find repetitive values in a range of cells. See here:

http://msdn.microsoft.com/en-us/lib...

The first example on that page used to be available in the VBA Help files. Why they took it out is beyond me. I have copied that example into my code countless times and then modified it to fit the searches I need to perform.

4 - Seriously - your entire macro could be rewritten without a single Select instruction.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#8
April 25, 2013 at 06:43:01
Thank you very much for your help!!I have 30+ columns to copy - I'm wondering if there is more efficient way to copy the whole row instead of one cell at a time.

Report •

#9
April 25, 2013 at 10:02:10
To answer your question, yes, you can copy the entire row, but since I didn't know how many columns you had, I just assumed it was the 3 stated above and created it accordingly.

All you need to do is adjust the Range Offset to accomodate how many columns you have. If you have 30 rows, it would looks something like this:

With ActiveSheet
            Do While i <= .Rows.Count
                If .Cells(i, 1) = FindString Then
                    Cells(i, 1).Select
                    Range(ActiveCell, ActiveCell.Offset(0, 29)).Copy
                        Sheets(NSheetName).Select
                        ActiveSheet.Paste
                        ActiveCell.Offset(1, 0).Select
                    Sheets("Sheet1").Select
                    
                ElseIf .Cells(i, 1) = "" Then
                    Exit Do
                End If
                i = i + 1
            Loop
        End With


Report •

#10
April 25, 2013 at 12:12:58
Thanks! It works great! However the ID is not in column A, it's in column AJ. I tried to chagne to code to
If .Cells(i, 36) = FindString Then
Cells(i, 36).Select
It didn't work.

Report •

#11
April 25, 2013 at 13:12:03
✔ Best Answer
"Cells(i, 36).Select" Needs to be the way it was before you changed it. You were right to change the "If .Cells(i, 36) = FindString Then" line so you can leave it, but change the second line back to:

Cells(i, 1).Select

The reason is it sets the cell selector at the begining of the row that matches ID's so the next line can hightlight everything.

Try that and let me know.


Report •

#12
April 25, 2013 at 13:44:36
Perfect!!!Thanks for your help!!!!

Report •

#13
April 25, 2013 at 14:13:07
No problem!! If everything works the way you want and you have no further questions on this specific topic, be sure to stop back and pick the best answer so others with similar questions know this thread is solved. Thanks!!

Report •

#14
April 29, 2013 at 08:52:52
Newbie10, Thanks for your help!
I'm trying to sort column s and column i on the New Sheet
Range("s2").Select

Selection.Sort Key1:=Range("s2"), Order1:=xlDescending, Key2:=Range("i2") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
It sorts both sheets. How can I just sort the New Sheet.

Thanks again!!


Report •

#15
April 29, 2013 at 09:40:37
Hey Simba11, Glad I could help you.

Even though you're still working on the same project, this is a different problem. Please start a new thread so if someone has a similar problem, they can easily find the answer to it.

In the meantime, I'll try to work up a solution for you.

Law if Logical Argument: Anything is possible if you don't know what you're talking about.


Report •


Ask Question