Find and Copy sheet line to form, change fields and write to the same sheet with new ID

Asked

Viewed 1,729 times

1

My question is as follows: I developed a VBA form with 20 fields, which registers in the Bdados spreadsheet, also inserting an ID. What I want is to find and copy a record of the spreadsheet to the form, filling all its fields then change some of them and write to Bdados with new ID.

In Excel it will be the same as copying a row , pasting into a new row and changing the ID and some cells.

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

I am a layman in VBA Excel and I still can’t find an example to use as inspiration for my project.

Thank you. For the 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
vba form excel-vba

  • Include in your question the code of what you have already managed to do.

  • I suggest you break your question into several smaller ones ( MVCE ). And explain exactly what each variable is, for example if txtdata is a TextBox? And what exactly is the problem you are encountering and that this code did not work.

  • The code works. The form records perfectly in the BD table. What I am not able to do is locate an already recorded record, copy it to the form, and after changing some fields, re-register it as a new record, with new ID nr.

1 answer

2


Example

As no example was defined, the following data were used for the tests:

Exemplo

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

Locate

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

  • Autofilter
  • Find
  • Lookup
  • Match
  • For loop with If conditional (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), because it decreases the iteration between the VBA and the Excel spreadsheet, therefore, it is the most recommended for large databases. However, the one that I find easier is the Find Method. So 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 value found. Then perform an action each time you find the defined 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

Upshot

Resultado Localizar

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

Form

An example form has been created:

Formulário Exemplo

Code Locate

Insert 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 by typing "A5" in Texbox5:

Resultado localizar

Code New Registration

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 Substituir

This is the result of pressing the second button:

Resultado Substituir

  • Thank you very much for the help. I will apply in my project and I will inform you if I can.

  • 1

    I adapted the code and ended up solving my problem. M..

Browser other questions tagged vba form excel-vba

You are not signed in. Login or sign up in order to post.