VBA coding help

Solby

New Member
Hi all,

Below is my coding that helps me search for a word/name in a certain column and return data that relates to this word/name. The values are returned in a neat userform. The only issue I have is that the text I search for may not be unique. There may be 2 or 3 other instances of this word/name. i.e I search for John Smith and it returns age, location etc etc. But my search will stop at the first John Smith found. Is there a piece of coding I can put in that will cycle through all the John Smiths and not just stop at the first instance found. Thanks in advance.

Private Sub txtTAname_Change()


Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Charolais SNPs Parentage")




wsLR = ws.Cells(Rows.Count, 18).End(xlUp).Row






For x = 6 To wsLR


If ws.Cells(x, 18) = Me.txtTAname Then

Me.txtTAnumber = ws.Cells(x, "O")
Me.txtTAstatus = ws.Cells(x, "V")
Me.txtSname = ws.Cells(x, "AC")
Me.txtSstatus = ws.Cells(x, "AF")
Me.txtDname = ws.Cells(x, "X")
Me.txtDstatus = ws.Cells(x, "AA")
Me.txtTAid = ws.Cells(x, "N")


Exit Sub

End If


Next x


End Sub
 

gallen

Well-known Member
Hello & welcome,

You would need to use the find method. I started writing the solution but you fail to explain what exactly to do if there is more than one instance of search value found

Ie: Find one instance so fill text boxes on form, find another instance - do we overwrite the text boxes?
 

mse330

Active Member
Welcome to Mr. Excel Solby !

You can place your code in code tags to make it easier to read by using
Rich (BB code):
Rich (BB code):
 before your code and [/ code] after your code (without the space) … For more details click the link in my signature

Now to your question, you can keep looping until the end to find all occurrences of the search text by removing the "Exit Sub" line but I think you're copying the data into a user form so if you do, it will override the previous search results & will keep the last one only


	
	
	


Rich (BB code):
Private Sub txtTAname_Change()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Charolais SNPs Parentage")
wsLR = ws.Cells(Rows.Count, 18).End(xlUp).Row
For x = 6 To wsLR
    If ws.Cells(x, 18) = Me.txtTAname Then
        Me.txtTAnumber = ws.Cells(x, "O")
        Me.txtTAstatus = ws.Cells(x, "V")
        Me.txtSname = ws.Cells(x, "AC")
        Me.txtSstatus = ws.Cells(x, "AF")
        Me.txtDname = ws.Cells(x, "X")
        Me.txtDstatus = ws.Cells(x, "AA")
        Me.txtTAid = ws.Cells(x, "N")
    Exit Sub ' <--- this line
    End If
Next x
End Sub
 

gallen

Well-known Member
This code may explain it better. Read the comments and let me know what to do (or the code may point you in the right way of the solution)

Code:
Private Sub txtTAname_Change_New()


    Dim ws As Worksheet
    Dim wsLr As Long
    Dim rSearch As Range 'range of cells to search
    Dim rFind As Range 'Used in the find method
    Dim sFirst As String 'save the first address we find
    
    'set the worksheet variable
    Set ws = ThisWorkbook.Sheets("Charolais SNPs Parentage")
    
    'get last used row in column 18
    wsLr = ws.Cells(Rows.Count, 18).End(xlUp).Row
    
    'set the search range to be R6 to last used row in column R
    Set rSearch = ws.Range(ws.Cells(6, 18), ws.Cells(wsLr, 18))
    
    Set rFind = rSearch.Find(Me.txtTAname)
    
    'check we have a match
    If rFind Is Nothing Then
        'no match so cancel search and inform user
        'MsgBox Me.txtTAname & " not found in search range", vbInformation, "Not Found"
        Exit Sub
    End If
    
    'If we get here we have a match
    
    'Remember the first address of found cell
    sFirst = rFind.Address
    
    'fill in the text boxes
    Me.txtTAnumber = ws.Cells(rFind.Row, "O")
    Me.txtTAstatus = ws.Cells(rFind.Row, "V")
    Me.txtSname = ws.Cells(rFind.Row, "AC")
    Me.txtSstatus = ws.Cells(rFind.Row, "AF")
    Me.txtDname = ws.Cells(rFind.Row, "X")
    Me.txtDstatus = ws.Cells(rFind.Row, "AA")
    Me.txtTAid = ws.Cells(rFind.Row, "N")
    
    'look for next instance
    Set rFind = rSearch.FindNext(rFind)
    
    'loop until the address of the found cell is the same as the first
    Do Until rFind.Address = sFirst
        'If we get here another instance has been found
        'it is here I'm unsure what to do with the additional instances of the found value
        
        
        
        '*code to deal with additional instances goes here
        
        
        'find next instance
        Set rFind = rSearch.FindNext(rFind)
    Loop


End Sub
 
Last edited:

Solby

New Member
Hi Gallen,

Thanks for the welcome and the help.

Yes, when I find another instance I want the userform text-boxes to fill out with the new information. Also, what do you think is the best way to look for a second instance occurring? Hit the enter button or make a button that will toggle through them?
 

Solby

New Member
This code may explain it better. Read the comments and let me know what to do (or the code may point you in the right way of the solution)

Code:
Private Sub txtTAname_Change_New()


    Dim ws As Worksheet
    Dim wsLr As Long
    Dim rSearch As Range 'range of cells to search
    Dim rFind As Range 'Used in the find method
    Dim sFirst As String 'save the first address we find
    
    'set the worksheet variable
    Set ws = ThisWorkbook.Sheets("Charolais SNPs Parentage")
    
    'get last used row in column 18
    wsLr = ws.Cells(Rows.Count, 18).End(xlUp).Row
    
    'set the search range to be R6 to last used row in column R
    Set rSearch = ws.Range(ws.Cells(6, 18), ws.Cells(wsLr, 18))
    
    Set rFind = rSearch.Find(Me.txtTAname)
    
    'check we have a match
    If rFind Is Nothing Then
        'no match so cancel search and inform user
        'MsgBox Me.txtTAname & " not found in search range", vbInformation, "Not Found"
        Exit Sub
    End If
    
    'If we get here we have a match
    
    'Remember the first address of found cell
    sFirst = rFind.Address
    
    'fill in the text boxes
    Me.txtTAnumber = ws.Cells(rFind.Row, "O")
    Me.txtTAstatus = ws.Cells(rFind.Row, "V")
    Me.txtSname = ws.Cells(rFind.Row, "AC")
    Me.txtSstatus = ws.Cells(rFind.Row, "AF")
    Me.txtDname = ws.Cells(rFind.Row, "X")
    Me.txtDstatus = ws.Cells(rFind.Row, "AA")
    Me.txtTAid = ws.Cells(rFind.Row, "N")
    
    'look for next instance
    Set rFind = rSearch.FindNext(rFind)
    
    'loop until the address of the found cell is the same as the first
    Do Until rFind.Address = sFirst
        'If we get here another instance has been found
        'it is here I'm unsure what to do with the additional instances of the found value
        
        
        
        '*code to deal with additional instances goes here
        
        
        'find next instance
        Set rFind = rSearch.FindNext(rFind)
    Loop


End Sub
Thanks Gallen, code looks good. Like I mentioned in the previous post I would like the textboxes in the userform to fill out with the new information.
 

gallen

Well-known Member
Ahhh now I understand so you want the user to be able to decide whether to accept these details or move on to the next?
 

Some videos you may like

This Week's Hot Topics

  • Importing multiple excel files into one spreadsheet
    Hi, I'm trying to import multiple excel files (with the same format into a single spreadsheet) so that each day's file is listed underneath the...
  • find many based on a certain criteria
    good evening, I hope someone can help me? I have a workbook sheet 2 contains lots of data.... I would like to be able to find anything on sheet...
  • How to copy multiple rows using If
    Hi all, I'm very new to VBA and have written this simple code to copy certain cells if a certain cell within that row contains any data. I need...
  • VBA If statement
    Dear All, I have two dates, where I'd like a message box to pop, if the dates are between this criteria. [CODE] sDate1 = #10/1/2019#...
  • Text Format
    I have a sheet for user to keyin the data. The format of the data can be 451 / 1903, 0012 / 9908 or 00287 / 0099. The number after the "/" is...
  • Macro to copy values across rows and transposing them and add the user id
    [FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]Hi,[/COLOR][/SIZE][/FONT] [FONT=Times New...
Top