Find and copy row from sheet to form, change fields, and write to same sheet with new ID

My question is the following: I developed a VBA form with 20 fields, which makes the registration in the BDados sheet, also entering an ID. What I intend is to locate and copy a record from the spreadsheet to the form, filling in all its fields then change some of them and write to BDados with new ID.

In Excel will be the same as copying a row, pasting a new row and making the change of ID and some cells.

It remains to add that the ID the sr is automatically inserted when the form is opened.

I am a layman in VBA Excel and I have not yet been able to find an example that will inspire me for my project.

Thank you. For help.

THE CODE ALREADY DEVELOPED IS AS FOLLOWS: 

Private Sub BTN_GRAVAR_Click()

Dim NR As Long
Dim DATA_MATRICULA As Date
Dim DATA_INICIAL As Date
Dim DATA_FINAL As Date



    Folha2.Select

    Range("A3").End(xlDown).Select

    NR = ActiveCell.Row

    Range("a65536").End(xlUp).Offset(1, 0).Select
    ActiveCell.Offset(0, 0).Value = LBL_NR.Caption
    ActiveCell.Offset(0, 1).Value = txtident.Text
    ActiveCell.Offset(0, 2).Value = txtmatricula.Text
    ActiveCell.Offset(0, 3).Value = txtdata.Text
    ActiveCell.Offset(0, 4).Value = txtcilindrada.Text
    ActiveCell.Offset(0, 5).Value = txtpeso.Text
    ActiveCell.Offset(0, 6).Value = Cbocombustivel.Text
    ActiveCell.Offset(0, 7).Value = cbolugares.Text
    ActiveCell.Offset(0, 8).Value = cbotipo.Text
    ActiveCell.Offset(0, 9).Value = cbocategoria.Text
    ActiveCell.Offset(0, 10).Value = txtpneuf.Text
    ActiveCell.Offset(0, 11).Value = txtpneut.Text
    ActiveCell.Offset(0, 12).Value = cboseguradora.Text
    ActiveCell.Offset(0, 13).Value = txtapolice.Text
    ActiveCell.Offset(0, 14).Value = txtvalorizacao.Text
    ActiveCell.Offset(0, 15).Value = txtinicial.Text
    ActiveCell.Offset(0, 16).Value = txtfinal.Text
    ActiveCell.Offset(0, 17).Value = Txtvalor.Text
    ActiveCell.Offset(0, 18).Value = txttaxa.Text
    ActiveCell.Offset(0, 19).Value = cbocentro.Text




    Columns("A:T").AutoFit



    txtident.Text = ""
    txtmatricula.Text = ""
    txtdata.Text = ""
    txtcilindrada.Text = ""
    txtpeso.Text = ""
    Cbocombustivel.Value = ""
    cbolugares.Value = ""
    cbotipo.Value = ""
    cbocategoria.Value = ""
    txtpneuf.Text = ""
    txtpneut.Text = ""
    cboseguradora.Value = ""
    txtapolice.Text = ""
    txtvalorizacao.Text = ""
    txtinicial.Text = ""
    txtfinal.Text = ""
    Txtvalor.Text = ""
    txttaxa.Text = ""
    cbocentro.Value = ""


    Me.LBL_NR = Folha2.Range("a65536").End(xlUp).Row - 1

    txtident.SetFocus


End Sub
Private Sub BTN_Sair_Click()

   Unload Me

End Sub







Private Sub txtdata_Change()
If Len(Me.txtdata.Text) = 2 Then
        Me.txtdata.Text = Me.txtdata.Text & "/"
        Me.txtdata.SelStart = 4
    ElseIf Len(Me.txtdata.Text) = 5 Then
        Me.txtdata.Text = Me.txtdata.Text & "/"
        Me.txtdata.SelStart = 7
    ElseIf Len(Me.txtdata.Text) = 10 Then
        Me.txtcilindrada.SetFocus
    End If


End Sub

Private Sub txtinicial_Change()

If Len(Me.txtinicial.Text) = 2 Then
        Me.txtinicial.Text = Me.txtinicial.Text & "/"
        Me.txtinicial.SelStart = 4
    ElseIf Len(Me.txtinicial.Text) = 5 Then
        Me.txtinicial.Text = Me.txtinicial.Text & "/"
        Me.txtinicial.SelStart = 7
    ElseIf Len(Me.txtinicial.Text) = 10 Then
        Me.txtfinal.SetFocus
    End If
End Sub

Private Sub txtfinal_Change()
If Len(Me.txtfinal.Text) = 2 Then
        Me.txtfinal.Text = Me.txtfinal.Text & "/"
        Me.txtfinal.SelStart = 4
    ElseIf Len(Me.txtfinal.Text) = 5 Then
        Me.txtfinal.Text = Me.txtfinal.Text & "/"
        Me.txtfinal.SelStart = 7
    ElseIf Len(Me.txtfinal.Text) = 10 Then
        Me.Txtvalor.SetFocus
    End If
End Sub



Private Sub txtmatricula_Change()

If Len(Me.txtmatricula.Text) = 2 Then
        Me.txtmatricula.Text = Me.txtmatricula.Text & "-"
        Me.txtmatricula.SelStart = 4
    ElseIf Len(Me.txtmatricula.Text) = 5 Then
        Me.txtmatricula.Text = Me.txtmatricula.Text & "-"
        Me.txtmatricula.SelStart = 8
    ElseIf Len(Me.txtmatricula.Text) = 8 Then
        Me.txtdata.SetFocus
    End If
End Sub



Private Sub UserForm_Initialize()

  Me.LBL_NR = Folha2.Range("a65536").End(xlUp).Row

End Sub
Author: Júlio Faria, 2018-01-20
Source

1 answers

Example

Since an example was not defined, the following data was used for the tests:

Example

This is an example and you should change it for your application.

Locate

To find a String in Excel there are numerous ways, such as:

  • Autofilter
  • Find
  • lookup
  • Match
  • for loop with conditional If (iterates each BD value and compares if it is equal to the desired value).
  • Variant Array, Scripting.Dictionary or Collection.

And other extra ways to refine the search, such as regular expressions.

The fastest is the use of arrays (Variant Array, Scripting.Dictionary or Collection), as it decreases the iteration between VBA and Excel spreadsheet, therefore it is the most recommended for large databases. However, the one I consider easier is the Find method. I.e., this will be used in conjunction with the example of the official reference.

Comparison of 3 methods for performance analysis (English)

Code

This code searches column A for the string strFind from the first to the last found value. It then performs an action each time it finds the set value.

Dim ws As Worksheet

Set ws = ThisWorkbook.Worksheets("Tabela BD")

LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
strfind = "A2"
With ws.Range("a1:a" & LastRow)
    Set cellFound = .Find(strfind, LookIn:=xlValues)
    If Not cellFound Is Nothing Then
        FirstAddress = cellFound.Address
        Do
            'Realiza Ação
            Debug.Print cellFound
            Debug.Print cellFound.Address
            Set cellFound = .FindNext(cellFound)
        Loop While Not cellFound Is Nothing And cellFound.Address <> FirstAddress
    End If
End With

Result

Result Locate

Where returns cellFound which is the string A2 and cellFound.Address which is the address of cellFound.

Form

An example form has been created:

Example Form

Code Locate

Enter a code to locate on a button: 

Private Sub CommandButton1_Click()
    Dim ws As Worksheet
    'Define o nome da planilha utilizada
    Set ws = ThisWorkbook.Worksheets("Tabela BD")
    'Última linha
    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    'String a procurar
    strfind = TextBox5.Value
    'Range a ser procurado (Coluna A)
    With ws.Range("a1:a" & LastRow)
        Set cellFound = .Find(strfind, LookIn:=xlValues)
        If Not cellFound Is Nothing Then
            FirstAddress = cellFound.Address
            Do
                'Realiza Ação
                TextBox1 = cellFound.Offset(0, 1)
                TextBox3 = cellFound.Offset(0, 2)
                'Encontra o próximo
                Set cellFound = .FindNext(cellFound)
            Loop While Not cellFound Is Nothing And cellFound.Address <> FirstAddress
        End If
    End With

End Sub

And the result is, typing " A5 " in Texbox5:

Result locate

New Registration Code 

Private Sub CommandButton2_Click()
    Dim ws As Worksheet
    Dim rng As Range
    'Define o nome da planilha utilizada
    Set ws = ThisWorkbook.Worksheets("Tabela BD")
    'Última linha
    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    'Define o Range rng
    Set rng = ws.Range("A" & LastRow + 1)
    'Escreve uma ID em A nova, com a string "A" junto com o número da linha de BD
    rng = "A" & LastRow + 1
    'Coluna ao lado direito de rng
    rng.Offset(0, 1) = TextBox2
    'Coluna duas vezes ao lado direito de rng
    rng.Offset(0, 2) = TextBox4

End Sub

This is the New Registration Form.

Form Replace

This is the result of tightening the second Button:

Result Replace

 2
Author: danieltakeshi, 2018-01-26 18:03:02