1

Trying to create a macro that will do a search for a cell value, then when found cut the entire row and past it to another sheet!

Help is appreciated, I've never programmed before in excel....

Sub test2()
Dim cel As Range, lRow As Long

findWhat = InputBox("Enter what you want to find?", "Find what...")

For Each cel In ThisWorkbook.Sheets("Sheet1").Range("W2:W250000" &Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row)
    
    If cel.Value = findWhat Then
        lRow = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
        ThisWorkbook.Sheets("Sheet2").Cells(lRow + 1, 1).Value = ThisWorkbook.Sheets("Sheet2").Cells(cel.Row, 1).Resize(, 48)
    End If
  Next
End Sub
Kidney
  • 11
  • 2
  • Is this finding it multiple times or just once? Cause you can use the .Find command to do this without looping if it's just once. – Simon Sep 07 '20 at 00:33
  • Offhand your code looks fine. Perhaps, if you tell us what you found wrong with it we can help you better. Meanwhile, the code might need an `Exit For` once a match was found and `ThisWorkbook.Sheets("Sheet2").Rows(cel.Row, 1).Copy Destination:=ThisWorkbook.Sheets("Sheet2").Cells(lRow + 1, 1)` would be a little simpler and copy (but not cut) formats as well as values. Cutting involves a separate deleting process. – Variatus Sep 07 '20 at 00:38
  • I need to find all of the rows that contains that specific value and transfer all of them to another sheet! – Kidney Sep 07 '20 at 01:31
  • Since everything is in 1 column, [Here](https://stackoverflow.com/questions/11631363/how-to-copy-a-line-in-excel-using-a-specific-word-and-pasting-to-another-excel-s) is a faster way to achieve what you want using Autofilter. After you copy the data(Cut is not supported in non contiguous range), delete the range. – Siddharth Rout Sep 07 '20 at 06:55
  • @Kidney if your issue is solved can you please tick an answer to close your question. If you didn't notice I updated my code so you don't have to run it multiple times. It should get all of them in the first try. – Simon Sep 07 '20 at 21:02

2 Answers2

0

I am just modifying some of your existing code to do what is required, assuming that you want to search only in column W and then copy the entire row if a match is found.

Sub test2()
Dim cel As Range, lRow As Long

findWhat = InputBox("Enter what you want to find?", "Find what...")

'Following loop will only search for the values in column W and between rows 2 to 250000, change the values as required.
For Each cel In ThisWorkbook.Sheets("Sheet1").Range("W2:W250000")
    
    If cel.Value = findWhat Then
        currentRow = cel.Row
        lRow = ThisWorkbook.Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
        Thisworkbook.Sheets("Sheet1").Rows(currentRow).EntireRow.copy
        ThisWorkbook.Sheets("Sheet2").Range("A" & lRow + 1 ).Select
        ThisWorkbook.Sheets("Sheet2").Paste 
        Thisworkbook.Sheets("Sheet1").Rows(currentRow).EntireRow.Delete 
    End If
  Next
End Sub

UPDATE: This code will copy all the rows that matches the given value.

Pulkit Jain
  • 79
  • 7
0

If you're just needing to find the input value once within the range you could use this to copy. If you're wanting to cut the line that you copy from as well then take away the ' from the delete line in the code.

This is for if you just want the first found cell:

Sub test2()

Dim lRow1 As Long, lRow2 As Long, found As Range, findwhat As String

findwhat = InputBox("Enter what you want to find?", "Find what...")
lRow1 = ThisWorkbook.Sheets("Sheet1").Range("W" & Rows.Count).End(xlUp).Row
lRow2 = ThisWorkbook.Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row

Set found = Sheets("Sheet1").Range("W2:W" & lRow1).Find(What:=findwhat, LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlNext)

If Not found Is Nothing Then
    Sheets("Sheet1").Range("W" & found.Row).EntireRow.Copy
    Sheets("Sheet2").Range("A" & lRow2 + 1).PasteSpecial
    'Sheets("Sheet1").Range("W" & found.Row).EntireRow.Delete
End If

Application.CutCopyMode = False

End Sub

EDIT: If you're needing every row that is found with that value then use this one. It's just modified from yours which is pretty much the easiest way to do it: EDIT2: Changed it so now it loops from the bottom up which resolves the issue of skipping some of them after deleting the row.

Sub test2()

Dim lRow1 As Long, lRow2 As Long, findwhat As String, cel As Range, Sh1 As Worksheet, Sh2 As Worksheet, i As Long

findwhat = InputBox("Enter what you want to find?", "Find what...")
lRow1 = ThisWorkbook.Sheets("Sheet1").Range("W" & Rows.Count).End(xlUp).Row
Set Sh1 = ThisWorkbook.Sheets("Sheet1")
Set Sh2 = ThisWorkbook.Sheets("Sheet2")

For i = lRow1 To 2 Step -1
    If Sh1.Range("W" & i).Value = findwhat Then
        
        lRow2 = Sh2.Range("A" & Rows.Count).End(xlUp).Row
        Sh1.Range("W" & i).EntireRow.Copy
        Sh2.Range("A" & lRow2 + 1).PasteSpecial
        Sh1.Range("W" & i).EntireRow.Delete
    End If
Next i

Application.CutCopyMode = False

End Sub
Simon
  • 1,384
  • 2
  • 10
  • 19
  • Worked, now just need to use the cut command or delete the found line after it's been pasted – Kidney Sep 07 '20 at 01:58
  • I will add the line in as well. It's literally just duplicating the copy line and changing .Copy with .Delete – Simon Sep 07 '20 at 02:04
  • had to do the script about 15 times to get them all on a files of 60k records – Kidney Sep 07 '20 at 02:43
  • It's because of when it deletes if the next found cell was the row below it will be skipped as deleting moves the cells up. Therefore we have to work from the bottom up which I'm almost done editing. – Simon Sep 07 '20 at 02:46
  • Updated the bottom code in my answer. If you have that many rows I suggest adding a `Application.ScreenUpdating = False` to the start of the scrip. Then set it to true at the end. – Simon Sep 07 '20 at 02:52