how to copy entire row (URGENT) Solved/Closed

Question

Hi people.     

i am doing on some assignment for school. I have created a userform with a search button embedded on one worksheet, lets call it SEARCHENGINE. when i press on the search button, the userform appear with textbox for me to type in text. suppose i type a title of a book in the textbook, the userform enables me to search through all the books in the rest of the 27 worksheets in the workbook. The problem comes. When the book is found, i make vba highlight the book title and copy the entire row. i want to copy the entire row to another worksheet. How do i do that? And when a new search is conducted. i want it to unhighlight the previous search and highlight the title of the new search and copy the entire row into the same worksheet, replacing the results found previously. i have been cracking my brain and i cant find a solution and i have to submit it soon. Please help me. thanks!

rizvisa1 · Answer

Since you know already the location, why not wipe the format before re-search. Could you please upload a sample file on some shared site like https://authentification.site and post back here the link to allow better understanding of how it is now and how you foresee.

rizvisa1 · Answer

There seems to be a bit of logical error in your code. I am putting in comments what I think should be the value. Modified lines are highlighted 


Private Sub cmdSearch_Click()  


Dim Search As String 
Dim Wks As Worksheet 

    Search = txtTitle.Text 
     
    If txtTitle.Text <> "" Then 
     
 
        ' clear the previous copied data  from row 2 and down
        Workbooks(1).Worksheets(28).Range("2:" & Rows.Count).Clear 
     
        For Each Wks In Workbooks(1).Worksheets 
         
            For Each cell In Wks.Range("B2").CurrentRegion.Columns(2).Cells 
             
                ' clear previous color 
                cell.Interior.ColorIndex = xlNone 
                 
                If InStr(1, UCase(cell.Value), UCase(Search)) > 0 Then 
                 
                    cell.Interior.ColorIndex = 6 

                    ' I think it should be  cell.EntireRow.copy 
                    ActiveCell.EntireRow.Copy 
                    Workbooks(1).Worksheets(28).Select 
                    Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
                 
                End If 
             
            Next 
         
        Next 
    End If 

End Sub

rizvisa1 · Answer

Try this macro. I tested for author it works, should work for others too.


Private Sub cmdSearch_Click()

Dim lMaxRows As Long 'max rows
Dim lMaxRows1 As Long ' max rows in col A
Dim lMaxRows2 As Long ' max rows in col B and temp value
Dim lMaxRows3 As Long ' max rows in col A
Dim sMaxRows As String ' which column has max column

Dim lResultRows As Long ' number of used rows in max search result screen

Dim sTitle As String ' title searched
Dim sISBN As String ' ISBN searched
Dim sAuthor As String 'author searched

Dim wb As Workbook ' workbook
Dim ws As Worksheet 'search worksheet

    'setting wb to this book
    Set wb = Workbooks(1)
    
    'setting searchforbook sheet
    Set ws = wb.Worksheets("SearchForBooks")
    
    'search item
    sISBN = txtISBN.Text
    sTitle = txtTitle.Text
    sAuthor = txtAuthor.Text
    
    'start of result
    lResultRows = 12
     
     On Error GoTo Err_Handler

    'freeze screen
    Application.ScreenUpdating = False
    
    ' clear the previous copied data from row 12 and down
     ws.Range(lResultRows & ":" & Rows.Count).Clear
     
     'loop thru each sheet
     For Each Wks In Workbooks(1).Worksheets
     
        'skip if the sheet name is SearchForBooks
        If Wks.Name = ws.Name Then GoTo Next_Wks
        
        'max used rows in col A
        lMaxRows1 = Wks.Cells(Rows.Count, "A").End(xlUp).Row
        
        'max used rows in col B
        lMaxRows2 = Wks.Cells(Rows.Count, "B").End(xlUp).Row
        
        'max used rows in col C
        lMaxRows3 = Wks.Cells(Rows.Count, "C").End(xlUp).Row
        
        ' get max used rows in col A
        lMaxRows = lMaxRows1
        sMaxRows = "A"
        
        ' check if col B has more rows than col A
        If lMaxRows2 > lMaxRows Then
            lMaxRows = lMaxRows2
            sMaxRows = "B"
        End If
        
        ' check if col C has more rows than col A and B
        If lMaxRows3 > lMaxRows Then
            lMaxRows = lMaxRows3
            sMaxRows = "C"
        End If
        
        'if filter is there, then remove filter
        If Wks.AutoFilterMode Then Wks.AutoFilterMode = False
        
        'remove any previous color
        Wks.Range("2:" & lMaxRows).Interior.ColorIndex = xlNone
        
        ' add filter
        Wks.Cells.AutoFilter
        
        ' ISBN FILTER
        If (sISBN <> "") Then
        
            ' apply filter for ISBN
            Wks.Cells.AutoFilter Field:=1, Criteria1:="=*" & sISBN & "*"
            
            'max visible rows after filter
            lMaxRows2 = Wks.Cells(Rows.Count, sMaxRows).End(xlUp).Row
            
            ' if max visible row is more than 1, then there is a record
            If lMaxRows2 > 1 Then
            
                'add color
                Wks.Range("A2:A" & lMaxRows2).Interior.ColorIndex = 6
                
                ' copy visible rows
                Wks.Range("2:" & lMaxRows2).Copy
                
                'select the search result sheet
                ws.Select
                
                ' select the cell from where the pase is to occur
                Range("A" & lResultRows).Select
                
                'paste
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                
                'get position from where next filter is to happen
                lResultRows = Cells(Rows.Count, sMaxRows).End(xlUp).Row + 1
                
            End If
            
        End If
        
        
        ' TITLE FILTER
        If (sTitle <> "") Then
        
            'remove filter from ISBN column
            Wks.Cells.AutoFilter Field:=1, Criteria1:="=*"
                
            'apply filter on title column
            Wks.Cells.AutoFilter Field:=2, Criteria1:="=*" & sTitle & "*"
                    
            'max visible rows after filter
            lMaxRows2 = Wks.Cells(Rows.Count, sMaxRows).End(xlUp).Row
        
            'add color
            If (lMaxRows2 > 1) Then Wks.Range("B2:B" & lMaxRows2).Interior.ColorIndex = 6
                                   
            ' identifying rows that were copied earlier due to ISBN MATCH and also has a match for title
            If (sISBN <> "") Then Wks.Cells.AutoFilter Field:=1, Criteria1:="<>*" & sISBN & "*"
            
            'max visible rows after filter
            lMaxRows2 = Wks.Cells(Rows.Count, sMaxRows).End(xlUp).Row
            
            ' if max visible row is more than 1, then there is a record
            If lMaxRows2 > 1 Then
                
                ' copy visible rows
                Wks.Range("2:" & lMaxRows2).Copy
                
                'select the search result sheet
                ws.Select
                
                ' select the cell from where the pase is to occur
                Range("A" & lResultRows).Select
                
                'paste
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                
                'get position from where next filter is to happen
                lResultRows = Cells(Rows.Count, sMaxRows).End(xlUp).Row + 1
                
            End If
            
        End If
        
        
        If (sAuthor <> "") Then
        
            'remove filter from ISBN column
            Wks.Cells.AutoFilter Field:=1, Criteria1:="=*"
            
            'remove filter from title column
            Wks.Cells.AutoFilter Field:=2, Criteria1:="*"
            
            ' apply filter for author
            Wks.Cells.AutoFilter Field:=3, Criteria1:="=*" & sAuthor & "*"
          
            'max visible rows after filter
            lMaxRows2 = Wks.Cells(Rows.Count, sMaxRows).End(xlUp).Row
        
            'add color
            If (lMaxRows2 > 1) Then Wks.Range("C2:C" & lMaxRows2).Interior.ColorIndex = 6
            
            ' identifying rows that were copied earlier due to ISBN MATCH and also has a match for sAuthor
            If (sISBN <> "") Then Wks.Cells.AutoFilter Field:=1, Criteria1:="<>*" & sISBN & "*"
            
            ' identifying rows that were copied earlier due to title MATCH and also has a match for sAuthor
            If (sAuthor <> "") Then Wks.Cells.AutoFilter Field:=2, Criteria1:="<>*" & sTitle & "*"
                  
            'max visible rows after filter
            lMaxRows2 = Wks.Cells(Rows.Count, sMaxRows).End(xlUp).Row
            
            ' if max visible row is more than 1, then there is a record
            If lMaxRows2 > 1 Then
            
                ' copy visible rows
                Wks.Range("2:" & lMaxRows2).Copy
                
                'select the search result sheet
                ws.Select
                
                ' select the cell from where the pase is to occur
                Range("A" & lResultRows).Select
                
                'paste
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                
                'get position from where next filter is to happen
                lResultRows = Cells(Rows.Count, sMaxRows).End(xlUp).Row + 1
                
            End If
            
        End If
        
        'remove filter
        Wks.AutoFilterMode = False
        
Next_Wks:
     
     Next Wks
     
     'update screen
     Application.ScreenUpdating = True
     DoEvents
     
    Exit Sub

Err_Handler:
    Application.ScreenUpdating = True
    DoEvents
    
    MsgBox Err.Description
     
End Sub

How to copy entire row (URGENT)

3 responses

Similar discussions

Subscribe To Our Newsletter!