appending and modifying records to excel log

[drago101]

Hi,


I am hoping someone can help with this problem

I have a simple macro that send details from a calculation spreadsheet to a log book so I can keep a record of all quotations our company does. Currently it simply adds a record to the bottom line. This works fine except when we redo a quote because details are updated. It would be better if I could find the previous record from the tracking number an modify the detail rather than creating multiple records with the same tracking number, or a new tracking number each time.

the existing code is below:

Sub send_to_log()
'
' send_to_log Macro
'
'
Sheets("DetailsToLog").Select
Range("A5:T5").Select
Selection.Copy
Workbooks.Open fileName:="J:\yyyy\xxx\Quotes_Log.xlsx"

Cells(Cells(1048576, 1).End(xlUp).Row + 1, 1).Select

Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWorkbook.Save
ActiveWindow.Close
Sheets("QUOTE").Select
Range("A1").Select
End Sub


the range A5:T5 contains the output details of the quote we store. cell f5 contains a unique tracking number (which are all in column f in the log book). What I'd like to do is have a way that the macro searches to see if this unique number already exists in a row. if so it will overwrite that row. otherwise it will append the quote details to the bottom of the log. I’ve tried using a find function but I’m not doing it correctly at all

Ideally I'd put in a warning message if overwriting but this is step two and I think I'll be able to search to find how to do that.


PS the version of excel is 2010 but it is an older .xls book that the macro is in.

 

[dmt32]

Hi and welcome to the board.

See if the following code helps you. It’s a bit of a mash as I have taken it largely from another I helped here with a similar need & adjusted to hopefully meet your requirement – but please understand it is not fully tested & you should amend as required.

Assuming what you are looking for is the ability to:

• Add New Record
• Find Existing Record
• Update Existing Record

then assign following code to four buttons on your input sheet (DetailsToLog).
I have assumed Forms Buttons are being used but you can change to CommandButtons if required. Apply preferred Captions to each button e.g.:
Add, Find, Update,Clear


Place ALL following Button Code In Standard Module:

Sub NewButton_Click()
send_to_log Action:=xlAdd
End Sub


Sub FindButton_Click()
send_to_log Action:=xlFind
End Sub


Sub UpdateButton_Click()
send_to_log Action:=xlUpdate
End Sub


Sub CancelButton_Click()
send_to_log Action:=xlCancel
End Sub

Place ALL following code in another Standard Module:

Dim DataRow As Long
Dim GetInput As Variant


'custom xlConstants
Public Const xlFind As Integer = 3
Public Const xlUpdate As Integer = 4


Sub send_to_log(ByVal Action As Integer)
'
' send_to_log Macro
'
'


    Dim wbLog As Workbook
    Dim wsDetailsToLog As Worksheet
    Dim DataRange As Range, FoundCell As Range, LogNo As Range
    Dim FileName As String, sPath As String
    Dim FileOpenPassword As String


    '*****************************************************************************
    '*********************************SETTINGS************************************


    sPath = "J:\yyyy\xxx\"
    FileName = "Quotes_Log.xlsx"
    FileOpenPassword = ""    'add password if required


    '*****************************************************************************
    'Your Log Data Entry Worksheet
    'Change Name As Required
    Set wsDetailsToLog = ThisWorkbook.Worksheets("DetailsToLog")
    
    'Log Sheet Data Entry Range
    Set DataRange = wsDetailsToLog.Range("A5:T5")




    On Error GoTo ExitSub
    If Action = xlCancel Then
        With DataRange
            .ClearContents
            .Cells(1, 1).Select
        End With
        DataRow = 0
        GoTo ExitSub
    Else
        Application.ScreenUpdating = False
        Set wbLog = OpenDatabase(DatabaseFile:=sPath & FileName, ReadOnly:=IIf(Action = xlFind, True, False), sPassword:=FileOpenPassword)


        If Not wbLog Is Nothing Then
            ThisWorkbook.Activate
            With wbLog
                With .Worksheets(1)
                    Select Case Action


                        'add new record
                    Case xlAdd
                        'if record being updated ignore button press
                        If DataRow > 0 Then GoTo ExitSub
                        'check log track no entered
                        Set LogNo = DataRange.Cells(1, 6)
                        If LogNo.Value > 0 Then
                            Set FoundCell = GetLog(Target:=.Columns("F"), Search:=LogNo.Value)
                            If FoundCell Is Nothing Then
                                DataRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
                                'add new record to log table
                                .Cells(DataRow, 1).Resize(1, DataRange.Columns.Count).Value = DataRange.Value


                                MsgBox "Log No: " & LogNo.Value & Chr(10) & _
                                       "New Record Added", 48, "New Record"


                                DataRange.ClearContents
                                DataRow = 0
                            Else
                                MsgBox "Log No: " & LogNo.Value & Chr(10) & _
                                       "Duplicated Log No." & Space(10), 16, "Log No Exists"
                                LogNo.Select
                                GoTo ExitSub
                            End If
                        Else
                            MsgBox "Log Tracking No Required", 16, "Entry Required"
                            LogNo.Select
                            GoTo ExitSub
                        End If


                        'update existing record
                    Case xlUpdate


                        If DataRow = 0 Then GoTo ExitSub


                        Set LogNo = DataRange.Cells(1, 6)
                        'ensure no change to log no.
                        LogNo.Value = GetInput
                        .Cells(DataRow, 1).Resize(1, DataRange.Columns.Count).Value = DataRange.Value
                        DataRange.ClearContents
                        MsgBox "Log No: " & GetInput & Chr(10) & _
                               "Record Updated" & Space(10), 48, "Record Updated"
                        DataRow = 0


                        'find existing record
                    Case xlFind
                        Application.ScreenUpdating = True
Trackno:
                        GetInput = InputBox("Enter Log Tracking Number", "Update Record")
                        If StrPtr(GetInput) = 0 Then GoTo ExitSub


                        If Len(GetInput) > 0 Then


                            Set FoundCell = GetLog(Target:=.Columns("F"), Search:=GetInput)


                            If Not FoundCell Is Nothing Then
                                'mark the record row
                                DataRow = FoundCell.Row
                                'return record to input sheet
                                DataRange.Value = .Cells(DataRow, 1).Resize(1, DataRange.Columns.Count).Value


                            Else


                                msg = MsgBox("Log No: " & GetInput & Chr(10) & _
                                             "Record Not Found" & Chr(10) & _
                                             "Do You Want To Retry?", 37, "Not Found")
                                If msg = 2 Then GoTo ExitSub
                                GoTo Trackno
                            End If
                        Else
                            MsgBox "Nothing Input!", 16, "Entry Required"
                            GoTo Trackno
                        End If
                        GoTo ExitSub


                    End Select
                End With
                .Close True
            End With
            Set wbLog = Nothing
        End If
    End If


ExitSub:
    If Not wbLog Is Nothing Then wbLog.Close False
    Application.ScreenUpdating = True
    If Err > 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub




Function GetLog(ByVal Target As Range, ByVal Search As String) As Range
    Set GetLog = Target.Find(Search, LookIn:=xlValues, LookAt:=xlWhole, _
                             SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                             MatchCase:=False, SearchFormat:=False)
End Function




Function OpenDatabase(ByVal DatabaseFile As String, ByVal ReadOnly As Boolean, Optional ByVal sPassword As String = "") As Workbook
    
    If Not Dir(DatabaseFile, vbDirectory) = vbNullString Then
        Set OpenDatabase = Workbooks.Open(DatabaseFile, ReadOnly:=ReadOnly, Password:=sPassword)
    Else
        MsgBox "File / Folder Not Found", 16, "Not Found"
        Set OpenDatabase = Nothing
    End If
End Function

As I have kept all operations for each Button mainly in one procedure, code may look a tad busy but hopefully, it will be self explanatory & is enough for you to adjust and adapt to meet your specific project need. Should also mention that Find part of code searches for a unique entry only of Log Number in Log Workbook. If you have multiple entries you will need to tidy your database to ensure correct records are returned.

Finally,
BEFORE TESTING NEW CODE MAKE CERTAIN THAT YOU HAVE A
BACKUP OF YOUR WORKBOOK.


Hope Helpful

Dave