Setup column to require unique entry

[gmaxey]

I have the following procedure that creates a new Excel worksheet. Most of it is trial and error but at least I understand what is going on. What I would like to do is learn how to set up this workbook so that each entry in the Client ID column is unique. Thanks for all forthcoming assistance and for your patience with a nub.

[VBA]Function CreateDataSheet() As String
Dim strFname As String
Dim strPath As String
Const strCaption As String = "Save the Excel data file in a folder of your choice. " & _
"You may change the default name if you wish."
'ShowError 2, 8
'Unload frmNotification
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err Then
Set xlApp = CreateObject("Excel.Application")
End If
On Error GoTo 0
Set xlWB = xlApp.Workbooks.Add
Set xlSheet = xlWB.Sheets(1)
With xlSheet
.Range("A1") = "Client ID"
.Range("B1") = "Company Name"
.Range("C1") = "Name"
.Range("D1") = "Address"
.Range("E1") = "e-mail"
.Range("F1") = "Terms"
.Columns("A:A").EntireColumn.ColumnWidth = "10"
.Columns("B:B").EntireColumn.ColumnWidth = "30"
.Columns("C:C").EntireColumn.ColumnWidth = "30"
.Columns("D").EntireColumn.ColumnWidth = "75"
.Columns("E:E").EntireColumn.ColumnWidth = "20"
.Columns("F:F").EntireColumn.ColumnWidth = "20"
End With
strFname = xlApp.GetSaveAsFilename("CustomClientList.xlsx", _
"Excel files (*.xlsx),*.xlsx", 1, strCaption)
If strFname <> "False" Then
xlWB.SaveAs strFname
End If
strPath = xlWB.FullName
xlWB.Close SaveChanges:=False
Set xlApp = Nothing
Set xlWB = Nothing
Set xlSheet = Nothing
CreateDataSheet = strPath
End Function
[/VBA]

[Bob Phillips]

You could add Data Validation to the column with a formula, assuming starting in A2, of

=COUNTIF($A$2:$A2,$A2)=1

other than that you need to add worksheet event code.

[gmaxey]

xld,

Is there a way to incorporate adding that formula to the A2 cell in the procedure that I use to create the worksheet?

[fredlo2010]

Hi gmaxey,

Like always xld with awesome ideas and suggestions. You can use the macro recorder to get a lot of information.

So here is the code implementing xld suggestion. There are other wasy to sort of get the same result. Like conditional formatting rules. I was actually trying that one out but I got an error in line ExecuteExel4Macro, so I gave up. I made some other changes to your code to shrink it a little ( and to apply what I am learning in the forum)

Some links here
http://www.mrexcel.com/forum/showthr...mula-Questions
http://www.ozgrid.com/Excel/highlight-duplicates.htm

Here is the modified code:

[VBA]Function CreateDataSheet() As String
Dim strFname As String
Dim strPath As String
Const strCaption As String = "Save the Excel data file in a folder of your choice. " & _
"You may change the default name if you wish."
'ShowError 2, 8
'Unload frmNotification

On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err Then
Set xlApp = CreateObject("Excel.Application")
End If

On Error GoTo 0
Set xlWB = xlApp.Workbooks.Add
Set xlSheet = xlWB.Sheets(1)

'rename the sheet to something meaningful
Application.Sheets(1).Name = "Data"

With xlSheet.Cells(1, 1).Resize(1, 6)
.Value = Array("Client ID", "Company Name", "Name", "Address", "e-mail", "Terms")
'I like my headers bold and centered but its up to you
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With

With xlSheet
.Cells(1, 1).ColumnWidth = 10
.Cells(1, 2).Resize(, 3).ColumnWidth = 30
.Cells(1, 4).ColumnWidth = 75
.Cells(1, 5).Resize(, 6).ColumnWidth = 20
End With


'use this to set the data validation up to row 100000000
With Range("A2:A1000000").Validation
.Add Type:=xlValidateCustom, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=COUNTIF($A$2:$A2,$A2)=1"
.IgnoreBlank = True
.InCellDropdown = True
.ErrorTitle = "ID Check"
.ErrorMessage = "This ID is already in use please use a different one"
.ShowError = True
End With

strFname = xlApp.GetSaveAsFilename("CustomClientList.xlsx", _
"Excel files (*.xlsx),*.xlsx", 1, strCaption)
If strFname <> "False" Then
xlWB.SaveAs strFname
End If
strPath = xlWB.FullName
xlWB.Close SaveChanges:=False
Set xlApp = Nothing
Set xlWB = Nothing
Set xlSheet = Nothing
CreateDataSheet = strPath

End Function
[/VBA]

Thanks

[gmaxey]

Well I didn't even know Excel had a recorder (or a developer tab for that matter) until you prompted me.

Your modified code seems to work well. While maybe not obvious, but you may have guessed, I am trying to set up a client list with a unique ID. I will be using this list to populate a userform in a Word template that I use to create invoices.

I've got that part working. I can call a new invoice, call the list, make a selection and populate fields in the UserForm. From there I can populate fields in the invoice itself.

What I want to do now is add a process to manually enter a new client directly in the invoice userform and then have the ability to add this new client information programatically to my Excel data source.

I figured that I needed a unique ID and rather than look at every entry to see if it was previously used, I thought if the Client ID had to be unique in the data source then it would be a simple matter of trying to add and if the try failed then I've found a duplicate.

The method xld suggests and you provided works if I try to add and existing ID in the opened Excel file, but before I pull my hair out trying to add it programatically from a Word template can you tell me if this will even be possible? I mean wil the error that Excel creates when I have the sheet physically opened result in some run-time error that I can trap and advise the user that the client ID attempted is already in use?

Really my ultimate goal is that if the ID entered in the userform is not already used then a new entry is created in the Excel file. If it is already used then the user will be alerted that the entry already exists and if they continue the entry will be overwritten. I hope this makes sense and I hope you or someone can advise if what I am after is even possible.

Thanks.

Hi gmaxey,

Like always xld with awesome ideas and suggestions. You can use the macro recorder to get a lot of information.

So here is the code implementing xld suggestion. There are other wasy to sort of get the same result. Like conditional formatting rules. I was actually trying that one out but I got an error in line ExecuteExel4Macro, so I gave up. I made some other changes to your code to shrink it a little ( and to apply what I am learning in the forum)

Some links here
http://www.mrexcel.com/forum/showthr...mula-Questions
http://www.ozgrid.com/Excel/highlight-duplicates.htm

Here is the modified code:

[vba]Function CreateDataSheet() As String
Dim strFname As String
Dim strPath As String
Const strCaption As String = "Save the Excel data file in a folder of your choice. " & _
"You may change the default name if you wish."
'ShowError 2, 8
'Unload frmNotification

On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err Then
Set xlApp = CreateObject("Excel.Application")
End If

On Error GoTo 0
Set xlWB = xlApp.Workbooks.Add
Set xlSheet = xlWB.Sheets(1)

'rename the sheet to something meaningful
Application.Sheets(1).Name = "Data"

With xlSheet.Cells(1, 1).Resize(1, 6)
.Value = Array("Client ID", "Company Name", "Name", "Address", "e-mail", "Terms")
'I like my headers bold and centered but its up to you
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With

With xlSheet
.Cells(1, 1).ColumnWidth = 10
.Cells(1, 2).Resize(, 3).ColumnWidth = 30
.Cells(1, 4).ColumnWidth = 75
.Cells(1, 5).Resize(, 6).ColumnWidth = 20
End With


'use this to set the data validation up to row 100000000
With Range("A2:A1000000").Validation
.Add Type:=xlValidateCustom, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=COUNTIF($A$2:$A2,$A2)=1"
.IgnoreBlank = True
.InCellDropdown = True
.ErrorTitle = "ID Check"
.ErrorMessage = "This ID is already in use please use a different one"
.ShowError = True
End With

strFname = xlApp.GetSaveAsFilename("CustomClientList.xlsx", _
"Excel files (*.xlsx),*.xlsx", 1, strCaption)
If strFname <> "False" Then
xlWB.SaveAs strFname
End If
strPath = xlWB.FullName
xlWB.Close SaveChanges:=False
Set xlApp = Nothing
Set xlWB = Nothing
Set xlSheet = Nothing
CreateDataSheet = strPath

End Function
[/vba]

Thanks

[gmaxey]

Hmm,

I don't think I can make this work. It appears that this has no effect if I write data to the cell range using VBA. The validation and message alert only appears when I attempt to write and existing number in a row lower in the sheet.

[VBA]Sub Test()
Dim strData As String
'I need this to be an invalid attempt to have the same data in any cell in column 1.
strData = ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(4, 1) = strData
End Sub[/VBA]

Any other ideas or have I missed your point? Thanks.

[Bob Phillips]

If you are trying to do this from a form, do the check there and then write to the cells, Data Validation is pointless.

On the form, you should check if the value is already used. For instance, assuming your input is in a textbox

[VBA]With Worksheets("Data")

If IsError(Application.Match(TextBox1.Text, .Columns(1),0)) Then

.Range("A4").Value = Textbox1.Text
End If
End With
[/VBA]


Are you actually running this code in Excel, or from another app? I assume the former if you are using a form, but I cannot understand why all of the late-binding stuff if so.

[gmaxey]

xld,

Sorry for the delay. I thought I would get an e-mail alert if I got another reply and haven't looked here until now.

I really don't understand your code. I've rarely done any programing in Excel and it is rather intimidating right now.

A few years ago I developed a template to create invoices with Word.

http://gregmaxey.mvps.org/word_tip_p..._for_word.html

Just as an exercise and learning experience, I wanted to see if I could employ Excel to:

1) Log invoices (Number, Client, Date, Status, etc.)
2) Use Excel to store regular client data (Company name, Contact, etc.)

So for goal 2, I wanted to create a worksheet with the appropriate columns and enter client data. Then when I create a new invoice I woud populate a listbox with the client data. The selected client data would then fill the userform and ultimately fill fields in the invoice document.

I want the information exchange between the worksheet and userform to be a two way street. For example I might enter new client data in the userform or edit existing client data and click a button to update the Excel list.

To do this I think I need a way to determine if a client record already exists or if I need to create a new record. Each client will have a unique ID. If the unique ID is already recorded in the Excel file then I want to modify that record with the data in the Userform. If not then I want to create a new record.

I have this working using the following albeit crude code:

[VBA]Sub AddUpdateClient(ByRef oFrmPassed As UserForm)
Dim strData As String
Dim arrName() As String
Select Case True
Case oFrmPassed.txtCustID.Text = ""
Beep
With oFrmPassed.lBillTo1
.Caption = "The Client ID field must be completed before you and add to or update the custom client data file."
.ForeColor = wdColorRed
End With
Exit Sub
End Select

strWorkBookName = GetSetting(p_AppID, "Template Data", "Data Source")
If Globals.fcnFileOrFolderExist(strWorkBookName) Then
'Initiate Excel Appliation
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err <> 0 Then
Application.StatusBar = "Please wait while Excel source is opened ... "
Set xlApp = CreateObject("Excel.Application")
bStarted = True
End If
On Error GoTo 0

'Open the workbook
Set xlWB = xlApp.Workbooks.Open(strWorkBookName)
Set xlSheet = xlWB.Sheets("Sheet1")
Application.StatusBar = ""
'Find the last record
lngRecordCount = xlSheet.Range("A" & xlSheet.Rows.count).End(xlUp).row + 1
'See if client ID already exists.
For i = 2 To lngRecordCount
If xlSheet.Cells(i, 1) = oFrmPassed.txtCustID.Text Then
'See if user wants to overwrite.
Notification.ShowNotification 10, 13, True, oFrmPassed.txtCustID.Text
If frmNotification.Tag = 0 Then
xlWB.Close SaveChanges:=False
Unload frmNotification
GoTo Cleanup
End If
Unload frmNotification
'Overwrite.

With xlSheet
.Cells(i, 1) = oFrmPassed.txtCustID.Text
'Cleanup data string.
strData = fcnStrData(oFrmPassed.txtCustomer.Text)
arrName() = Split(strData, "|")
.Cells(i, 2) = arrName(0)
.Cells(i, 3) = arrName(1)
strData = fcnStrData(oFrmPassed.txtCustomerAddress.Text)
.Cells(i, 4) = strData
.Cells(i, 5) = oFrmPassed.txtCustEmail.Text
.Cells(i, 6) = oFrmPassed.txtTerms.Text
End With
GoTo Cleanup
End If
Next i
'If we make it to here then it is a new unique client IDs.
With xlSheet
.Cells(lngRecordCount, 1) = oFrmPassed.txtCustID.Text
strData = fcnStrData(oFrmPassed.txtCustomer.Text)
arrName() = Split(strData, "|")
.Cells(lngRecordCount, 2) = arrName(0)
.Cells(lngRecordCount, 3) = arrName(1)
strData = fcnStrData(oFrmPassed.txtCustomerAddress.Text)
.Cells(lngRecordCount, 4) = strData
.Cells(lngRecordCount, 5) = oFrmPassed.txtCustEmail.Text
.Cells(lngRecordCount, 6) = oFrmPassed.txtTerms.Text
End With

Cleanup:
xlWB.Close SaveChanges:=True
If bStarted Then
xlApp.Quit
End If
Set xlApp = Nothing
Set xlWB = Nothing
Set xlSheet = Nothing
Set oDoc = Nothing
End If
Exit Sub
End Sub[/VBA]

Hopefully you will see that I am comparing every existing record with the ID passed from the form. If a match is found then I update the record. If a match isn't found then I add a record.

Is there a more efficient way to do this? Thank you.

[fredlo2010]

At this point I will step out and limit myself to watch and learn how the pros do it

[gmaxey]

Eureka!! I think I figured something out!! While perhaps still crude, this seems to work better:

[vba]Sub AddUpdateClient(ByRef oFrmPassed As UserForm)
Dim Index As Variant
Dim strData As String
Dim arrName() As String
Select Case True
Case oFrmPassed.txtCustID.Text = ""
Beep
With oFrmPassed.lBillTo1
.Caption = "The Client ID field must be completed before you can add to or update the custom client data file."
.ForeColor = wdColorRed
End With
Exit Sub
End Select

strWorkBookName = GetSetting(p_AppID, "Template Data", "Data Source")
If Globals.fcnFileOrFolderExist(strWorkBookName) Then
'Initiate Excel Appliation
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err <> 0 Then
Application.StatusBar = "Please wait while Excel source is opened ... "
Set xlApp = CreateObject("Excel.Application")
bStarted = True
End If
On Error GoTo 0

'Open the workbook
Set xlWB = xlApp.Workbooks.Open(strWorkBookName)
Set xlSheet = xlWB.Sheets("Sheet1")
Application.StatusBar = ""
'Find the last record
lngRecordCount = xlSheet.Range("A" & xlSheet.Rows.count).End(xlUp).row + 1

'See if client ID already exists.
'Returns the row number if a match is found in column 1 (Customer ID)
Index = xlApp.Match(oFrmPassed.txtCustID.Text, Columns(1), 0)
If IsError(Index) Then
'MsgBox "Not Found"
'Add a new row with the client data.
With xlSheet
.Cells(lngRecordCount, 1) = oFrmPassed.txtCustID.Text
strData = fcnStrData(oFrmPassed.txtCustomer.Text)
arrName() = Split(strData, "|")
.Cells(lngRecordCount, 2) = arrName(0)
On Error Resume Next
.Cells(lngRecordCount, 3) = arrName(1)
On Error GoTo 0
strData = fcnStrData(oFrmPassed.txtCustomerAddress.Text)
.Cells(lngRecordCount, 4) = strData
.Cells(lngRecordCount, 5) = oFrmPassed.txtCustEmail.Text
.Cells(lngRecordCount, 6) = oFrmPassed.txtTerms.Text
End With
Else
'MsgBox "Match item: " & Index
Notification.ShowNotification 10, 13, True, oFrmPassed.txtCustID.Text
If frmNotification.Tag = 0 Then
xlWB.Close SaveChanges:=False
Unload frmNotification
GoTo Cleanup
End If
Unload frmNotification
'Overwrite indexed row.
With xlSheet
.Cells(Index, 1) = oFrmPassed.txtCustID.Text
'Cleanup data string.
strData = fcnStrData(oFrmPassed.txtCustomer.Text)
arrName() = Split(strData, "|")
.Cells(Index, 2) = arrName(0)
On Error Resume Next
.Cells(Index, 3) = arrName(1)
On Error GoTo 0
strData = fcnStrData(oFrmPassed.txtCustomerAddress.Text)
.Cells(Index, 4) = strData
.Cells(Index, 5) = oFrmPassed.txtCustEmail.Text
.Cells(Index, 6) = oFrmPassed.txtTerms.Text
End With
Unload frmNotification
End If
xlWB.Close SaveChanges:=True
Cleanup:
If bStarted Then
xlApp.Quit
End If
Set xlApp = Nothing
Set xlWB = Nothing
Set xlSheet = Nothing
Set oDoc = Nothing
End If
Exit Sub
End Sub[/vba]