Page 2 of 3 FirstFirst 123 LastLast
Results 11 to 20 of 21

Thread: VBA coding help

  1. #11
    Board Regular gallen's Avatar
    Join Date
    Jun 2011
    Location
    Manchester UK
    Posts
    1,896
    Post Thanks / Like
    Mentioned
    21 Post(s)
    Tagged
    1 Thread(s)

    Default Re: VBA coding help

    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.

    Code:
    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

    - forum use guidelines, forum rules and terms of use

    - Try searching for your answer first, see how

    - Read the FAQs

    - List of BB codes


  2. #12
    New Member
    Join Date
    Aug 2019
    Posts
    11
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA coding help

    Quote Originally Posted by gallen View Post
    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.

    Code:
    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?

  3. #13
    Board Regular gallen's Avatar
    Join Date
    Jun 2011
    Location
    Manchester UK
    Posts
    1,896
    Post Thanks / Like
    Mentioned
    21 Post(s)
    Tagged
    1 Thread(s)

    Default Re: VBA coding help

    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

    - forum use guidelines, forum rules and terms of use

    - Try searching for your answer first, see how

    - Read the FAQs

    - List of BB codes


  4. #14
    New Member
    Join Date
    Aug 2019
    Posts
    11
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA coding help

    Quote Originally Posted by gallen View Post
    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.

  5. #15
    Board Regular gallen's Avatar
    Join Date
    Jun 2011
    Location
    Manchester UK
    Posts
    1,896
    Post Thanks / Like
    Mentioned
    21 Post(s)
    Tagged
    1 Thread(s)

    Default Re: VBA coding help

    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.

    - forum use guidelines, forum rules and terms of use

    - Try searching for your answer first, see how

    - Read the FAQs

    - List of BB codes


  6. #16
    New Member
    Join Date
    Aug 2019
    Posts
    11
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA coding help

    Quote Originally Posted by gallen View Post
    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.

  7. #17
    Board Regular gallen's Avatar
    Join Date
    Jun 2011
    Location
    Manchester UK
    Posts
    1,896
    Post Thanks / Like
    Mentioned
    21 Post(s)
    Tagged
    1 Thread(s)

    Default Re: VBA coding help

    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

    - forum use guidelines, forum rules and terms of use

    - Try searching for your answer first, see how

    - Read the FAQs

    - List of BB codes


  8. #18
    New Member
    Join Date
    Aug 2019
    Posts
    11
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA coding help

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

  9. #19
    New Member
    Join Date
    Aug 2019
    Posts
    11
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA coding help

    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?

  10. #20
    Board Regular gallen's Avatar
    Join Date
    Jun 2011
    Location
    Manchester UK
    Posts
    1,896
    Post Thanks / Like
    Mentioned
    21 Post(s)
    Tagged
    1 Thread(s)

    Default Re: VBA coding help

    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:
    Code:
    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?

    - forum use guidelines, forum rules and terms of use

    - Try searching for your answer first, see how

    - Read the FAQs

    - List of BB codes


Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •