GBSingh
GBSingh

Reputation: 426

search a worksheet for all value VBA Excel

I have a worksheet that has multiple value and what I would like to do is search say column "B" for a value and when it finds it to copy the complete row and paste it somewhere else. I have a similar function to do this but it stops after it finds the first one which is fine for the situation that I am using it in but for this case I need it to copy all that match. below is the code that im using at the moment that only gives me one value

    If ExpIDComboBox.ListIndex <> -1 Then
    strSelect = ExpIDComboBox.value
    lastRow = wks1.range("A" & Rows.Count).End(xlUp).row
    Set rangeList = wks1.range("A2:A" & lastRow)
    On Error Resume Next
        row = Application.WorksheetFunction.Match(strSelect, wks1.Columns(1), 0) ' searches the worksheet to find a match
    On Error GoTo 0
    If row Then

Thanks

Upvotes: 0

Views: 199

Answers (3)

GBSingh
GBSingh

Reputation: 426

Thanks for your replys. I tired to use both methods but for some reason they did not seem to work. They did not give me an error they just did not produce anything.@mielk I understand what you mean about using an array to do this and it will be a lot faster and more efficent but I dont have enfough VBA knowledge to debug as to why it did not work. I tried other methods and finally got it working and thought it might be usefull in the future for anybody else trying to get this to work. Thanks once again for your answers :)

Private Sub SearchButton2_Click()
Dim domainRange As range, listRange As range, selectedString As String, lastRow As Long, ws, wks3 As Excel.Worksheet, row, i As Long
Set wks3 = Worksheets("Exceptions") '<----- WorkSheet for getting exceptions
If DomainComboBox.ListIndex <> -1 Then '<----- check that a domain has been selected
    selectedString = DomainComboBox.value
    lastRow = wks3.range("A" & Rows.Count).End(xlUp).row ' finds the last full row
    Set listRange = wks3.range("G2:G" & lastRow) 'sets the range from the top to the last row to search
    i = 2
    'used to only create a new sheet is something is found
    On Error Resume Next
        row = Application.WorksheetFunction.Match(selectedString, wks3.Columns(7), 0) ' searches the worksheet to find a match
    On Error GoTo 0
    If row Then
        For Each ws In Sheets
            Application.DisplayAlerts = False
            If (ws.Name = "Search Results") Then ws.Delete 'deletes any worksheet called search results
            Next
            Application.DisplayAlerts = True
        Set ws = Sheets.Add(After:=Sheets(Sheets.Count)) 'makes a new sheet at the end of all current sheets
        ws.Name = "Search Results" 'renames the worksheet to search results
        wks3.Rows(1).EntireRow.Copy 'copys the headers from the exceptions page
        ws.Paste (ws.Cells(, 1)) 'pastes the row into the search results page
        For Each domainRange In listRange ' goes through every value in worksheet trying to match what has been selected
            If domainRange.value = selectedString Then
            wks3.Rows(i).EntireRow.Copy ' copys the row that results was found in
            emptyRow = WorksheetFunction.CountA(ws.range("A:A")) + 1 ' finds next empty row
            ws.Paste (ws.Cells(emptyRow, 1)) 'pastes the contents
            End If
            i = i + 1 'moves onto the next row
        ws.range("A1:Q2").Columns.AutoFit 'auto fit the columns width depending on what is in the a1 to q1 cell
        ws.range("A1:Q1").Cells.Interior.ColorIndex = (37) 'fills the header with a colour
        Application.CutCopyMode = False 'closes the paste funtion to stop manual pasting
        Next domainRange ' goes to next value
    Else
        MsgBox "No Results", vbInformation, "No Results" 'display messgae box if nothing is found
        Exit Sub
    End If
End If
End Sub

Thanks.

N.B. this is not the most efficent way of doing this read mielk's answer and the other answer as they are better if you can get them working.

Upvotes: 0

luke_t
luke_t

Reputation: 2985

I have used the Range.Find() method to search each row. For each row of data which it finds, where the value you enter matches the value in column G, it will copy this data to Sheet2. You will need to amend the Sheet variable names.

Option Explicit
Sub copyAll()
    Dim rngFound As Range, destSheet As Worksheet, findSheet As Worksheet, wb As Workbook
    Dim strSelect As String, firstFind As String

    Set wb = ThisWorkbook
    Set findSheet = wb.Sheets("Sheet1")
    Set destSheet = wb.Sheets("Sheet2")
    strSelect = ExpIDComboBox.Value
    Application.ScreenUpdating = False
    With findSheet
        Set rngFound = .Columns(7).Find(strSelect, LookIn:=xlValues)
        If Not rngFound Is Nothing Then
            firstFind = rngFound.Address
            Do
                .Range(.Cells(rngFound.Row, 1), .Cells(rngFound.Row, _
                    .Cells(rngFound.Row, .Columns.Count).End(xlToLeft).Column)).Copy
                destSheet.Cells(destSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).PasteSpecial Paste:=xlPasteAll 
                Set rngFound = .Columns(2).Find(strSelect, LookIn:=xlValues, After:=.Range(rngFound.Address))
            Loop While firstFind <> rngFound.Address
        End If
    End With
    Application.ScreenUpdating = True
End Sub

I've assumed you will have data between columns A:G? Otherwise you can just amend the .Copy and .PasteSpecial methods to fit your requirements.

Upvotes: 0

mielk
mielk

Reputation: 3940

I would suggest to load data into array first and then operate on this array instead of operating on cells and using Worksheet functions.

'(...)
Dim data As Variant
Dim i As Long
'(...)


If ExpIDComboBox.ListIndex <> -1 Then
    strSelect = ExpIDComboBox.Value
    lastRow = wks1.Range("A" & Rows.Count).End(xlUp).Row

    'Load data to array instead of operating on worksheet cells directly - it will improve performance.
    data = wks1.Range("A2:A" & lastRow)


    'Iterate through all the values loaded in this array ...
    For i = LBound(data, 1) To UBound(data, 1)

        '... and check if they are equal to string [strSelect].
        If data(i, 1) = strSelect Then
            'Row i is match, put the code here to copy it to the new destination.
        End If

    Next i

End If

Upvotes: 1

Related Questions