Search and Update Records

[AFidytek]

Hi all

I have a excel database with a capture form (not userform - merely a separate sheet) running Macro to update a different sheet with the information captured in the capture form. Adding it to the last row. Now I need to find a solution to use a similar "capture" form or search form, whereby the user can find a record in the database. Once found they must be able to update the information and save (override) the record that they have updated.

I'm currently using a advanced filter (with background Macro) to search for the record in the database (unfortunately within the database and not on a separate sheet, the user must then identify the correct record and update it through the required columns, which reads difficult as my datasheet has 45 columns and is currently standing on 4298 rows.

The risk is that the incorrect column gets updated because of its cumbersome nature.

I know this is a tall order but if there is anyone out there that has a idea, please share.

I am not keen on using a MS Access database, it becomes a nightmare with a slow connection and we are working from different sites. Excel is more stable in my opinion.

Please share your ideas.

Ultimately:
Separate search sheet, with the same information as per the capture sheet (+1 extra which is the database ID) and transpose pastes the identified record into the sheet and we can update the information, then on save it will override the record with the same database ID.

Your help is appreciated.

Thanks

A

 

[AFidytek]

Hi Dave

I have sorted the sharing issues, but I get a error in the code. I am not sure if I am defining the datarange wrong:

Private Sub CommandButton2_Click()    Dim Foundcell As Range, DataEntryRange As Range
    Dim Search As String




'get search value
    Search = Me.Range("H4").Value
    If Len(Search) = 0 Then Exit Sub




'define data entry input range adjust as required to match your input form
[B]    Set DataEntryRange = Me.Range("D3") = ThisWorkbook.Worksheets("Sheet1").Columns(1)[/B]
    Set DataEntryRange = Me.Range("D4") = ThisWorkbook.Worksheets("Sheet1").Columns(2)
    Set DataEntryRange = Me.Range("D5") = ThisWorkbook.Worksheets("Sheet1").Columns(3)


'find search value in database
    Set Foundcell = ThisWorkbook.Worksheets("Sheet1").Columns(45).Find(Search, LookIn:=xlValues, lookat:=xlWhole)
    If Not Foundcell Is Nothing Then
'return database record to your data entry form
    DatabaseToDataEntry DataEntryRange, Foundcell
    Else
'inform user
    MsgBox Search & Chr(10) & "Record Not Found", 48, "Not Found"
    End If
End Sub

Error is on the bold part

Thank you for the help Dave.

Regards

Ancois

 

[AFidytek]

Hi Dave

I have sorted the sharing issues, but I get a error in the code. I am not sure if I am defining the datarange wrong:

Private Sub CommandButton2_Click()    Dim Foundcell As Range, DataEntryRange As Range
    Dim Search As String




'get search value
    Search = Me.Range("H4").Value
    If Len(Search) = 0 Then Exit Sub




'define data entry input range adjust as required to match your input form
[B]    Set DataEntryRange = Me.Range("D3") = ThisWorkbook.Worksheets("Sheet1").Columns(1)[/B]
    Set DataEntryRange = Me.Range("D4") = ThisWorkbook.Worksheets("Sheet1").Columns(2)
    Set DataEntryRange = Me.Range("D5") = ThisWorkbook.Worksheets("Sheet1").Columns(3)


'find search value in database
    Set Foundcell = ThisWorkbook.Worksheets("Sheet1").Columns(45).Find(Search, LookIn:=xlValues, lookat:=xlWhole)
    If Not Foundcell Is Nothing Then
'return database record to your data entry form
    DatabaseToDataEntry DataEntryRange, Foundcell
    Else
'inform user
    MsgBox Search & Chr(10) & "Record Not Found", 48, "Not Found"
    End If
End Sub

Error is on the bold part

Thank you for the help Dave.

Regards

Ancois

 

[dmt32]

The dataentry range will be the All the cells of your input form as shown in RED in the code I posted in the link.

If still having problems need to find method to place copy of your workbook in public place like dropbox & provide link to it here.

Dave

 

[AFidytek]

I have now selected the entire rangeon my input form, and a new error comes up:

Set Foundcell = ThisWorkbook.Worksheets("Sheet1").Columns(45).Find(Search, LookIn:=xlValues, lookat:=xlWhole)

On this part of the code.

I cant share the workbook, I have confidential information contained in it.

Sorry

A

 

[AFidytek]

OMG I got it to work.

testing second part now.

 

[AFidytek]

Dave

The search and return formula works perfectly. Thank you so much.

When I now update the record in the capture form and use the already active button of Save and Clear it duplicates the retrieved record?

In the code below (as per your instructions) I have a stand alone module - (General) but I am not seeing any code in the below that will update that specific record. Am I doing this right? I don't want a new entry to be created.

Again, thank you so much for your help.

Sub DatabaseToDataEntry(ByVal DataEntryFormRange As Range, ByVal Target As Range)'dmt32 Oct 2017
    Dim Cell As Range
    Dim i As Integer
    Dim CellCount As Long
    Dim Data As Variant
    
'count of input cells
    CellCount = DataEntryFormRange.Cells.Count
'create array from range
    Data = Application.Transpose(Target.Parent.Cells(Target.Row, 1).Resize(1, CellCount).Value)




    On Error GoTo exitsub
'turn event code off
    Application.EnableEvents = False
    i = 1
    With DataEntryFormRange.Parent
'step thru each cell in named range
        For Each Cell In DataEntryFormRange
'check if input form range has formula
            If Not .Cells(Cell.Row, Cell.Column).HasFormula Then
'return data to correct cell in form
                .Cells(Cell.Row, Cell.Column).Value = Data(i, 1)
            End If
'increment to next array element
            i = i + 1
        Next Cell
    End With
    
exitsub:
'turn event code on
    Application.EnableEvents = True
    On Error GoTo 0
End Sub

 

[dmt32]

Hi,
the code provides method to return a record from your database back to the entry form
You have not published code you have to post record from your entry form to the database but where you have a line of code that finds the next new row you need to update it so it can handle returning an edited record back to correct row.

To do this, You would use the value from Range Object variable FoundCell which returns the record row.

Dave

 

[AFidytek]

Hi dave

So this is my code when loading a new record. D47 on sheet "capture" is the variable. How would I change it to return the updated information back to that line of data?

Private Sub CommandButton1_Click()If Range("D3").Value = "" And _
    Range("D5").Value = "" Or _
    Range("D14").Value = "" Or _
    Range("D23").Value = "" Or _
    Range("D25").Value = "" Then
       MsgBox "Please complete all minimum required fields - Record NOT Saved", vbCritical
        
        Exit Sub
Else
  Application.ScreenUpdating = False
  Dim copySheet As Worksheet
  Dim pasteSheet As Worksheet


  Set copySheet = Worksheets("Capture")
  Set pasteSheet = Worksheets("Database")


  copySheet.Range("D3:D46").Copy
pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues, Transpose:=True
  Application.CutCopyMode = True
  Application.ScreenUpdating = True
Range("D3:D47").ClearContents
MsgBox prompt:="Your record has been succesfully saved to the database", Title:="Record Updated"
End If
End Sub

 

[dmt32]

Try this update for your CommandButton1 code

Private Sub CommandButton1_Click()
    Dim copySheet As Worksheet, pasteSheet As Worksheet
    Dim RecordRow As Long
    Dim cell As Range
    
    For Each cell In Range("D3,D5,D14,D23,D25")
        With cell
        If Len(.Value) = 0 Then
            cell.Select
        MsgBox "Please complete all minimum required fields - Record NOT Saved", vbCritical, "Entry required"
        Exit Sub
        End If
    Else
    
    Application.ScreenUpdating = False
    
    Set copySheet = Worksheets("Capture")
    Set pasteSheet = Worksheets("Database")
    
    RecordRow = IIf(Val(Range("D3").ID) > 0, Val(Range("D3").ID), _
    pasteSheet.Cells(pasteSheet.Rows.Count, "A").End(xlUp).Row + 1)
    
    copySheet.Range("D3:D46").Copy
    pasteSheet.Cells(RecordRow, 1).PasteSpecial xlPasteValues, Transpose:=True
    
     With Application
        .CutCopyMode = False: .ScreenUpdating = True
     End With
    Range("D3:D47").ClearContents
    Range("D3").ID = 0
    MsgBox "Your record has been successfully saved to the database",48,"Record Updated"
End If
End Sub

In your CommandButton2 code you will need to add the line of code shown below in RED

'find search value in database
    Set Foundcell = ThisWorkbook.Worksheets("Sheet1").Columns(45).Find(Search, LookIn:=xlValues, lookat:=xlWhole)
    If Not Foundcell Is Nothing Then
     Range("D3").ID = Foundcell.Row
'return database record to your data entry form
    DatabaseToDataEntry DataEntryRange, Foundcell
    Else
'inform user
    MsgBox Search & Chr(10) & "Record Not Found", 48, "Not Found"
    End If

Dave

 

[dmt32]

Sorry, in too much of hurry when I last posted

Private Sub CommandButton1_Click()
    Dim copySheet As Worksheet, pasteSheet As Worksheet
    Dim RecordRow As Long
    Dim cell As Range
    
    For Each cell In Range("D3,D5,D14,D23,D25")
        With cell
        If Len(.Value) = 0 Then
                .Select
            MsgBox "Please complete all minimum required fields - Record NOT Saved", vbCritical, "Entry required"
            Exit Sub
        End If
        End With
    Next cell
   
    
    Application.ScreenUpdating = False
    
    Set copySheet = Worksheets("Capture")
    Set pasteSheet = Worksheets("Database")
    
    RecordRow = Val(Range("D3").ID)
    RecordRow = IIf(RecordRow > 0, RecordRow, _
    pasteSheet.Cells(pasteSheet.Rows.Count, "A").End(xlUp).Row + 1)
    
    copySheet.Range("D3:D46").Copy
    pasteSheet.Cells(RecordRow, 1).PasteSpecial xlPasteValues, Transpose:=True
    
     With Application
        .CutCopyMode = False: .ScreenUpdating = True
     End With
     
    Range("D3:D47").ClearContents
    Range("D3").ID = 0
    
    MsgBox "Your record has been succesfully saved to the database", 48, "Record Updated"


End Sub

Dave