[Solved] find value in all cells in sheet then copy entire row to other sheet

[bigme]

good morning,
need some assists to my task, i need to find multiple value in all cells in a sheets and then copy entire row of the cells contain the value to other sheet, kindly help me please, thank you.

regards,
bigMe

 

[Yousuf Shovon]

i need to find multiple value in all cells in a sheets and then copy entire row of the cells contain the value to other sheet

Hello BigMe,
Thanks for sharing your experience. You want to find multiple values in all cells in a sheet and later copy the entire row to other sheets. The conditions in the Excel file are:
1. "What if I need to find multiple values, for example, to find apple and grape (later maybe I need to find more than 2 values) then copy all rows to other sheets"
2. "Need to delete blank cells so the result is only in columns A & B."
Based on your given data, you can find multiple values and copy them to another sheet using a UserForm through Excel VBA. The UserForm ensures you are selecting the right data to find & copy. See the article to create UserForm in Excel VBA:
Create Excel VBA UserForm
Here is the VBA code embedded in the UserForm:

Option Explicit


Private Sub CommandButton1_Click()
Dim sValue As String, i As Long, j As Long, k As Long, m As Long
For i = 0 To Me.ListBox1.ListCount - 1
    If Me.ListBox1.Selected(i) = True Then
        j = j + 1
    End If
Next
If j = 0 Then
    MsgBox "No item was selected."
    Exit Sub
End If
Sheet2.Cells.ClearContents
Dim arr As Variant
arr = getArrayOfData()
For i = 1 To UBound(arr, 1)
    For j = 1 To UBound(arr, 2)
        sValue = Trim$(arr(i, j) & "")
        If (Len(sValue) <> 0) And (IsNumeric(sValue) = False) Then
            For m = 0 To UserForm1.ListBox1.ListCount - 1
                If UserForm1.ListBox1.Selected(m) And UserForm1.ListBox1.List(m) = sValue Then
                    k = k + 1
                    Sheet2.Cells(k, 1) = sValue
                    Sheet2.Cells(k, 2) = arr(i, j + 1)
                End If
            Next
        End If
    Next
Next
Me.Hide
End Sub

Private Sub UserForm_Initialize()

Dim Itm As String
Dim d As Object

Set d = CreateObject("Scripting.Dictionary")

Dim arr As Variant
Dim i As Long, j As Long
arr = getArrayOfData()
For i = 1 To UBound(arr, 1)     'rows
    For j = 1 To UBound(arr, 2) 'columns
        Itm = Trim$(arr(i, j) & "")
        If Len(Itm) <> 0 Then
            If IsNumeric(Itm) = False Then
                d(Itm) = 1
            End If
        End If
    Next
Next
If d.Count <> 0 Then
    Me.ListBox1.List = d.Keys
End If
Set d = Nothing
End Sub

Private Function getRS(Optional ByVal strFilter As String = "") As Object
    Const adOpenKeyset As Long = 1
    Const adLockOptimistic = 3
    Dim xlXML As Object
    Dim adoRecordset As Object
    Dim rng As Range

    Set rng = Sheet1.UsedRange
    Set adoRecordset = CreateObject("ADODB.Recordset")
    Set xlXML = CreateObject("MSXML2.DOMDocument")
    xlXML.LoadXML rng.Value(xlRangeValueMSPersistXML)
    adoRecordset.Open xlXML, CursorType:=adOpenKeyset, LockType:=adLockOptimistic

    If Len(strFilter) Then
        adoRecordset.Filter = strFilter
    End If

    Set getRS = adoRecordset

End Function

Public Function getArrayOfData() As Variant
getArrayOfData = Sheet1.UsedRange
End Function

It allows you to select items in a ListBox, and upon clicking a button, it filters and extracts corresponding data from Sheet1 to populate another sheet (Sheet2).
You also need a public subroutine to call and show the UserForm. Insert this in a module:

Option Explicit
Public Sub ShowForm()
UserForm1.Show
End Sub

The UserForm is ready to go now. To find and copy the desired data from one sheet to another, use the following steps:
1. Click on the command button named Click here.

2. Select your data. For multiple data, you can either press Ctrl + Click or drag to select them.

3. Click the command button named Put to Sheet2.

As a result, the selected values appear in Sheet2.
I am attaching the Excel file for you to practice and implement to your original data. Thank you.

Regards,
Yousuf Shovon