Find and Copy Sheet Row to Form, Change Fields, and Write to Same Worksheet with New ID

Question

Find and Copy Sheet Row to Form, Change Fields, and Write to Same Worksheet with New ID

Navigation

#1 by (2 votes)

1

My question is this: I have developed a 20-field VBA form, which registers in the BDados worksheet, also inserting an ID. What I want is to find and Copy a record from the worksheet to the form, filling in all its fields after changing some of them and writing to the BData with new ID.

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

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

I'm a layman in VBA Excel and I still can not find an example that will inspire me for my project.

Thank you. For help.

THE CODE ALREADY DEVELOPED IS THE FOLLOWING:

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 excel-vba

asked by anonymous 20.01.2018 / 12:53

1 answer

Error executing function in PL / SQL How to remove white margin from a Carousel (Bootstrap)?

score 2 · Accepted Answer

Example

Since no example was defined, the following data was used for testing:

Thisisanexampleandyoushouldchangeitforyourapplication.

Find

TofindaStringinExceltherearelotsofways,like:

AutoFilter
Find
Lookup
Match
For loop with conditional If (It identifies each value of the DB and compares if it is equal to the desired value).
Variant Array, Scripting.Dictionary or Collection.

And other extra ways to refine your search, such as Regular Expressions.

The fastest is to use Arrays (Variant Array, Scripting.Dictionary, or Collection) because it slows the iteration between VBA and Excel spreadsheet, so it is best recommended for large databases. However, the one I find the easiest is the Find Method. Therefore, this will be used in conjunction with the example of the official reference.

Comparison of 3 methods for performance analysis

Code

This code looks in column A, for the string strFind from the first to the last found value. Then perform an action each time it finds the value set.

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

InthatreturnscellFoundwhichisthestringA2andcellFound.AddresswhichisthecellFoundaddress.

Form

Asampleformwascreated:

FindCode

Enteracodetolocateabutton:

PrivateSubCommandButton1_Click()DimwsAsWorksheet'DefineonomedaplanilhautilizadaSetws=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" into Texbox5:

NewRegistrationCode

PrivateSubCommandButton2_Click()DimwsAsWorksheetDimrngAsRange'DefineonomedaplanilhautilizadaSetws=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.

Thisistheresultofpressingthesecondbutton: