Copying matching rows in two columns in excel

Question

What I am trying to achieve is to search a list of texts in column G with column B of the same excel sheet (Sheet1) and if any match occurs then that whole row must be copied and paste it in another sheet(Sheet2). Actually I have tried a lot to debug the code but it is not working. Any help would be greatly appreciated! I have attached the code below.

Thank You Anuj

Sub SearchForString()

   Dim LSearchRow As Integer
   Dim LCopyToRow As Integer
   Dim searchTerm As String

   On Error GoTo Err_Execute


   LSearchRow = 2
   LCopyToRow = 2


  For i = 2 To 15
      searchTerm = Range("G" & i).Text
      If Range("B" & CStr(LSearchRow)).Value = searchTerm Then


         Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
         Selection.Copy


         Sheets("Sheet2").Select
         Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
         ActiveSheet.Paste


         LCopyToRow = LCopyToRow + 1


         Sheets("Sheet1").Select

      End If

Next i

LSearchRow = LSearchRow + 1

   Application.CutCopyMode = False
   Range("A3").Select

   MsgBox "All matching data has been copied!"

   Exit Sub

Err_Execute:
   MsgBox "An error occurred!"

End Sub

How many rows are there in columns `B` and `G`? At the moment `LSearchrow` is always `2`, so you never move down the column `B`. — Aneta, Jul 18 '18 at 08:27
Column B and G respectively has 2160 and 14 values. I have set LSearchrow to 2 as it starts to pick values from row 2. — Anuj, Jul 18 '18 at 12:20

Vityata · Answer 1 · 2018-07-18T13:48:00.740

0

Public Sub HereComesTheCode()

    Dim copyToRow As Long: copyToRow = 2
    Dim wks1 As Worksheet: Set wks1 = Worksheets(1)
    Dim wks2 As Worksheet: Set wks2 = Worksheets(2)
    Dim i As Long

    For i = 2 To 15            
        If wks1.Cells(i, "B") = wks1.Cells(i, "G") And wks1.Cells(i, "B") <> "" Then

            wks1.Range(wks1.Cells(i, "B"), wks1.Cells(i, "G")).Copy
            wks2.Cells(copyToRow, "B").PasteSpecial xlPasteAll
            copyToRow = copyToRow + 1
            Application.CutCopyMode = False                
        End If                
    Next i 

End Sub

Declare the variables as Long, not as Integer;
How to avoid using Select in Excel VBA
Declare less variables, you do not need them all;

edited Jul 18 '18 at 13:48

answered Jul 18 '18 at 08:31

Vityata

42,633
8
55
100

I have tried to run it but actually it is not giving any output. Can you please paste the whole code so that I will figure out what I am doing wrong? – Anuj Jul 18 '18 at 13:25
@AnujMavlankar - I guess your comment is for the other answer? This is the whole code. – Vityata Jul 18 '18 at 13:26
Vityata, I have tried your code snippet but it is not working. – Anuj Jul 18 '18 at 13:40
@AnujMavlankar - which part is not working? Are you receiving wrong values? Where? An error? Where? – Vityata Jul 18 '18 at 13:41
It doesnot give any error but also it doesn't produce any output. Could you please suggest. – Anuj Jul 18 '18 at 13:45
@AnujMavlankar - are you sure? Can you try step-by-step with F8? Probably your worksheet is not the first one? `wks1` is referring to the first one in Excel. – Vityata Jul 18 '18 at 13:47
I have tried again and still being the same. My data lies in first sheet only and second sheet where it is expected to paste the matching rows is empty. – Anuj Jul 18 '18 at 14:01
@Anuj I thing that the problem is that there is only one loop and Vityata is expecting to find match on the same row. But considering your comment to the original question (2161 rows in column B and 15 rows in column G), it won't be the case. – Aneta Jul 18 '18 at 14:09

score 0 · Answer 2 · answered Jul 18 '18 at 12:55

I assume that the matching values don't have to be in the same row.

For i = 2 To Range("G" & Rows.Count).End(xlUp).Row
  searchTerm = Range("G" & i).Text
  For LSearchRow = 1 To Range("B" & Rows.Count).End(xlUp).Row
  If Range("B" & CStr(LSearchRow)).Value = searchTerm Then
     Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Copy
     Sheets("Sheet2").Select
     Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
     ActiveSheet.Paste
     LCopyToRow = LCopyToRow + 1
     Sheets("Sheet1").Select
  End If
  Next LSearchRow
Next i

Copying matching rows in two columns in excel

2 Answers2