VBA coding help

[Solby]

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]

Hello,

This code fills in the form and then asks the user if they want to accept. If they click no it will fill in the next available details and so on.

This is untested as I haven't set a form up etc... It should at least give you the foundations for the solution.

Private Sub txtTAname_Change_New()


    Dim ws As Worksheet
    Dim x As Long 'counter
    Dim Results() As String
    Dim sRow As Long
    Dim wsLr As Long
    Dim rSearch As Range 'range of cells to search
    Dim rFind As Range 'Used in the find method
    
    '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
    
    'initialise counter for array
    x = 1
    
    'initialise array
    ReDim Results(x) 'this will always be the first one
    
    'Remember the first address of found cell
    Results(x) = rFind.Address 'store address in first array element
    
    '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 = Results(1)
        'if code gets here then more than 1 instance was found
        
        'increment the counter
        x = x + 1
        
        'add another element to array keeping the previous
        ReDim Preserve Results(x)
        
        'store the address
        Results(x) = rFind.Address
        
        'find next instance
        Set rFind = rSearch.FindNext(rFind)
    Loop
    
    'Reset counter
    x = 1
    
TryAgain:
    'store the row number of the 'x' item
    sRow = ws.Range(Results(x)).Row
    
    'fill in the text boxes
    Me.txtTAnumber = ws.Cells(sRow, "O")
    Me.txtTAstatus = ws.Cells(sRow, "V")
    Me.txtSname = ws.Cells(sRow, "AC")
    Me.txtSstatus = ws.Cells(sRow, "AF")
    Me.txtDname = ws.Cells(sRow, "X")
    Me.txtDstatus = ws.Cells(sRow, "AA")
    Me.txtTAid = ws.Cells(sRow, "N")
    
    'if we have more than 1 element in array we have multiple instances so confirm with user
    If UBound(Results) > 1 Then
        If MsgBox("Accept these details?", vbQuestion + vbYesNo, "Accept?") = vbNo Then
            If x = UBound(Results) Then 'we've gone to last found item and so go back to first
                x = 1
            Else
                x = x + 1
            End If
            GoTo TryAgain
        End If
    End If


End Sub

 

[Solby]

Hello,

This code fills in the form and then asks the user if they want to accept. If they click no it will fill in the next available details and so on.

This is untested as I haven't set a form up etc... It should at least give you the foundations for the solution.

Private Sub txtTAname_Change_New()


    Dim ws As Worksheet
    Dim x As Long 'counter
    Dim Results() As String
    Dim sRow As Long
    Dim wsLr As Long
    Dim rSearch As Range 'range of cells to search
    Dim rFind As Range 'Used in the find method
    
    '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
    
    'initialise counter for array
    x = 1
    
    'initialise array
    ReDim Results(x) 'this will always be the first one
    
    'Remember the first address of found cell
    Results(x) = rFind.Address 'store address in first array element
    
    '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 = Results(1)
        'if code gets here then more than 1 instance was found
        
        'increment the counter
        x = x + 1
        
        'add another element to array keeping the previous
        ReDim Preserve Results(x)
        
        'store the address
        Results(x) = rFind.Address
        
        'find next instance
        Set rFind = rSearch.FindNext(rFind)
    Loop
    
    'Reset counter
    x = 1
    
TryAgain:
    'store the row number of the 'x' item
    sRow = ws.Range(Results(x)).Row
    
    'fill in the text boxes
    Me.txtTAnumber = ws.Cells(sRow, "O")
    Me.txtTAstatus = ws.Cells(sRow, "V")
    Me.txtSname = ws.Cells(sRow, "AC")
    Me.txtSstatus = ws.Cells(sRow, "AF")
    Me.txtDname = ws.Cells(sRow, "X")
    Me.txtDstatus = ws.Cells(sRow, "AA")
    Me.txtTAid = ws.Cells(sRow, "N")
    
    'if we have more than 1 element in array we have multiple instances so confirm with user
    If UBound(Results) > 1 Then
        If MsgBox("Accept these details?", vbQuestion + vbYesNo, "Accept?") = vbNo Then
            If x = UBound(Results) Then 'we've gone to last found item and so go back to first
                x = 1
            Else
                x = x + 1
            End If
            GoTo TryAgain
        End If
    End If


End Sub

Thanks Gallen, You're help is much appreciated. Is it possible to attach this code to a button? So the search doesn't begin until I press the button?

 

[gallen]

Yes. Create the button on your form (assuming active X) double click it and type the name of this sub in the code block that is autogenerated
Apologies, I assumed you knew how to call a macro from a button

 

[Solby]

Yes. Create the button on your form (assuming active X) double click it and type the name of this sub in the code block that is autogenerated
Apologies, I assumed you knew how to call a macro from a button

I do. I was just confirming it. I have an exit button and a clear button. Thanks for all the help. I'm a novice at VBA and coding but I was happy enough with how far I gotten on my own.

 

[gallen]

Re-reading my post I see it may be taken as slightly patronising. Apologies if it was. Certainly not meant to be.

I meant the fact you had working buttons I was OK to skip that.

To be dealing with vba forms and manipulating data via controls, I think you can safely say you are moving away from "Novice" Good luck with the rest of your project.

 

[Solby]

Re-reading my post I see it may be taken as slightly patronising. Apologies if it was. Certainly not meant to be.

I meant the fact you had working buttons I was OK to skip that.

To be dealing with vba forms and manipulating data via controls, I think you can safely say you are moving away from "Novice" Good luck with the rest of your project.

You weren't all. I couldn't be happier with your help.

I'm still struggling with the search though. If I paste a name in, the text boxes will automatically fill with the data. Which ultimately is what i want. I just want to be able to type/paste a name then press the button and the search will start.

 

[gallen]

If it does it when you paste then you have code in the textbox change event. Delete it. If still struggling paste all your code and we can see what is happening

 

[Solby]

Yep, that was the problem. Working a treat now. Thanks.

 

[Solby]

Gallen,

One more query for you which has been bugging me. I have date received and date reported text boxes. They should just fill out with the dates that are in their corresponding cells from the data sheet. But on the userform they change to the US date format. I've tried a few bits of code but it only seems to work intermittently. Codes I've tried are as follows:

TxtDateRec = Format(TxtDateRec.Value, "dd/mm/yyyy")



and

Private Sub TxtDateRec_Change()
On Error Resume Next


myD = Left(Me.TxtDateRec, 2)
myM = Mid(Me.TxtDateRec, 4, 2)
myY = Right(Me.TxtDateRec, 4)


myDate = TxtDateRec.Value


Me.TxtDateRec.Value = Format(myDate, "dd/mm/yyyy")
End Sub



Any ideas what to try next?

 

[gallen]

I've tried recreating the issue but to no avail. I can only imagine it has something to do with the local settings.

I created a simple form with 2 textboxes (txtD1 & txtD2) and a button to 'get data'

The code was very basic:

Private Sub cmdGet_Click()


    txtD1 = Sheet1.Range("B1")
    txtD2 = Sheet1.Range("B2")
    
End Sub

This worked every time. The format on my sheet was showing as just "dd-mmm" and the format on the text boxes was displaying as "dd/mm/yyyy"

So not sure why. What format are the cells set to?