Assign Unique ID Number to Each File from Seperate Spreadsheet

[corporateaccount]

Hey guys and gals,

Ok, here's my set up right now. Whenever a user gets a new complaint call, he/she opens up the complaint form and fills everthing out:



Once, complete, he/she then clicks on 'insert file no' button to open the file number spreadsheet (which is a linked file located on the network.



The file numbers are already filled in. The user fills in the Date of Call, Date of Incident and Username on their own. They copy the file number from this sheet to their complaint form.

As it is now, the process is a little combersome and slow. Is there a way to automate this with a button press?

If possible, please let me know and thank-you for your help.

R

 

[pbornemeier]

The date & time of call should default to =Now() (appropriately formatted and changed to a value when the worksheet is activated), and could be changed manually, if required.
The user name could be obtained from the environment variable (or a sign in cell, if you are not on a machine that requires a login.

The insert file number macro should use the date/time of call, date/time of incident and username as parameters to open the file number spreadsheet, find the next available file number, and place the parameters in the appropriate columns, then return that complaint number to the calling procedure, which will insert the file number in the complaint form, and save & close the file number workbook. The macro will have to exit gracefully if the file number workbook is being used by someone else.

 

[corporateaccount]

The date & time of call should default to =Now() (appropriately formatted and changed to a value when the worksheet is activated), and could be changed manually, if required.
The user name could be obtained from the environment variable (or a sign in cell, if you are not on a machine that requires a login.

The insert file number macro should use the date/time of call, date/time of incident and username as parameters to open the file number spreadsheet, find the next available file number, and place the parameters in the appropriate columns, then return that complaint number to the calling procedure, which will insert the file number in the complaint form, and save & close the file number workbook. The macro will have to exit gracefully if the file number workbook is being used by someone else.

Thanks for the reply. Any way you could be more specific with some code or workbook examples?

Thank-you,
CAR

 

[pbornemeier]

This is not fully tested and I made many assumptions in coding it. Test it on copies of your data before depending on it.

Given the following:
On the complaint form, these named values stored in indicated cells:
a) file number (F4)
b) date of call (C6)
c) Time of call (L6)
d) date of incident (G8)
e) username (S6)
2) The Complaint Form is in a workbook named Complaint on a worksheet named Complaint WKS
3) Complaint workbook contains a worksheet named Temp
4) The Complaint workbook contains a worksheet called "Blank Complaint" that is a duplicate of the Blank Complaint Form
4) The File Number worksheet is in a workbook named File Number on a worksheet named File Number WKS
5) Workbooks("File Number.xls").Worksheets("File Number WKS").Range("E1").Formula equals =COUNTA($B:$B)+1

Place this code in the ThisWorkbook code page of the Complaint.xls file

Option Explicit

Private Sub Workbook_Open()

    Dim booFound As Boolean
    Dim intX As Integer

    If Worksheets.Count = 255 Then
        MsgBox "There are 255 worksheets in this workbook.  Save a copy of this workbook with the appropriate name,  Open the Complaint.xls workbook and delete all the existing filled in complaint forms and continue."
        Exit Sub
    End If
    
    If Len(Environ("USERNAME")) <> 0 Then
        Worksheets("Temp").Range("A1") = Environ("USERNAME")
    Else
        Worksheets("Temp").Range("A1") = InputBox("Enter User Name")
    End If
    
    booFound = False
    For intX = 1 To Worksheets.Count
        If Worksheets(intX).Name = "Complaint WKS" Then
            booFound = True
            Exit For
        End If
    Next
    If Not booFound Then
        Sheets("Blank Complaint").Select
        Sheets("Blank Complaint").Copy Before:=Sheets(1)
        ActiveSheet.Name = "Complaint WKS"
    End If
End Sub

Place this code in the Blank Complaint worksheet code page of the Complaint.xls file

Option Explicit

Private Sub cmdInsert_Click()
    Dim intX As Integer
    Dim booFound As Boolean
    Dim lngNextRow As Long
    
    Select Case Sheets.Count
        Case 254
            MsgBox "There are 254 worksheets in this workbook.  After this complaint has been saved, save a copy of this workbook with the appropriate name,  Open the Complaint.xls workbook and delete all the existing filled in complaint forms and continue."
            Exit Sub
        Case 255
            MsgBox "There are 255 worksheets in this workbook.  Save a copy of this workbook with the appropriate name,  Open the Complaint.xls workbook and delete all the existing filled in complaint forms and continue."
            Exit Sub
    End Select
    
    booFound = False
    For intX = 1 To Workbooks.Count
        If Workbooks(intX).Name = "File Number.xls" Then booFound = True
    Next
    If Not booFound Then
        MsgBox "Open the File Number worksheet and try again."
        Exit Sub
    End If
    
    lngNextRow = Workbooks("File Number.xls").Worksheets("File Number WKS").Range("E1").Value
    
    If ActiveSheet.Name = "Complaint WKS" Then
        Worksheets("Complaint WKS").Range("F4") = _
            Workbooks("File Number.xls").Worksheets("File Number WKS").Cells(lngNextRow, 1).Value
        With Workbooks("File Number.xls").Worksheets("File Number WKS")
            .Cells(lngNextRow, 2) = Worksheets("Complaint WKS").Range("C6").Value & " " & Format(Worksheets("Complaint WKS").Range("L6").Value, "hh:mm")
            .Cells(lngNextRow, 3) = Worksheets("Complaint WKS").Range("G8").Value
            .Cells(lngNextRow, 4) = Worksheets("Complaint WKS").Range("S6").Value
        End With
    End If
    
    ActiveSheet.Name = Worksheets("Complaint WKS").Range("F4").Value
    
    For intX = ActiveSheet.Shapes.Count To 1 Step -1
        ActiveSheet.Shapes(intX).Delete
    Next
    
    ActiveWorkbook.Save
    Workbooks("File Number").Save

    Sheets("Blank Complaint").Select
    Sheets("Blank Complaint").Copy Before:=Sheets(1)
    ActiveSheet.Name = "Complaint WKS"
    Range("C6").Value = Format(Now(), "DD MMM YYYY")
    Range("L6").Value = Format(Now(), "hh:mm")
    Range("S6").Value = Worksheets("Temp").Range("A1")
    

End Sub

Private Sub Worksheet_Activate()
    If ActiveSheet.Name = "Complaint WKS" Then
        Range("C6").Value = Format(Now(), "DD MMM YYYY")
        Range("L6").Value = Format(Now(), "hh:mm")
        Range("S6").Value = Worksheets("Temp").Range("A1")
    End If
End Sub