RE: Synchronize changes between a workbook and a "master file".

TraciAnn,

Further to my suggestion of establishing a Hotmail address so that we can
communicate and include attachments, if the privacy of names is a problem
then you could use the following program to create a list of random strings
and then copy the workbooks and replace the names.

I sincerely suggest that you do this because I think that it is going to be
extremely difficult for us to communicate on the same wavelength if I can’t
see a copy of the workbooks.

Also see a sample of creating unique Id’s after the random strings. I can
adapt this to suit your workbooks if I can get a copy of the workbooks. (I’m
thinking that it might require a Userform to enter new names.)

Random String Creation:
Open a new workbook.
Create an ActiveX Command button. (Default name and caption of the button is
OK.)
Right click the button and select View code.
Copy the code below (between the asterisk lines) into the VBA editor between
the Private Sub and End Sub that is inserted by default.
Close VBA editor.
Turn off Design Mode.
Save workbook. (Any name)
When you run the code, initially accept the default values at the Input Box
prompts and you can view what it does. Later you should only have to change
the number of strings required.
Copy the random strings and replace any names in the workbooks to send.

Note: The code will not create duplicate strings. If the user does not use a
minimum length of string long enough to create unique strings for the total
number of strings requested then a message will be displayed and the
processing terminated.

'*****************************************
'Creates a list of Random Strings
Dim intMinLgth As Integer
Dim intMaxLgth As Integer
Dim rngHeaderCell As Range
Dim lngNumbStrgs As Long
Dim strPrompt As String
Dim strTitle As String
Dim intProgMin As Integer
Dim intProgMax As Integer
Dim r As Long
Dim i As Integer
Dim intRandLgth As Integer
Dim strToCreate As String
Dim lngRow As Long
Dim lngCol As Long
Dim intLoopCounter As Integer

'Edit following line to the minimum length of
'string the user is allowed to enter.
intProgMin = 1

'Edit following line to the maximum length of
'string the user is allowed to enter.
intProgMax = 12

strTitle = "Parameters for Strings"
strPrompt = "Click in the cell where the list is to start."
On Error Resume Next
Set rngHeaderCell = Application.InputBox _
(strPrompt, _
Default:="$A$1", _
Title:=strTitle, _
Type:=8)
On Error GoTo 0
If rngHeaderCell Is Nothing Then
MsgBox "User cancelled." & vbCrLf & _
"Processing terminated."
Exit Sub
End If

strPrompt = "Enter the number of random strings required."

lngNumbStrgs = Application.InputBox _
(strPrompt, _
Default:=100, _
Title:=strTitle, _
Type:=1)
If lngNumbStrgs = 0 Then
MsgBox "User entered zero or cancelled." & vbCrLf & _
"Processing terminated."
Exit Sub
End If

strPrompt = "Enter the Minimum length of string." & _
vbCrLf & "Cannot be less than " & _
intProgMin & " or more than " & _
intProgMax & "."
Do
intMinLgth = Application.InputBox _
(strPrompt, _
Default:=6, _
Title:=strTitle, _
Type:=1)
If intMinLgth = 0 Then
MsgBox "User cancelled." & vbCrLf & _
"Processing terminated."
Exit Sub
End If
Loop While intMinLgth < intProgMin Or _
intMinLgth > intProgMax


strPrompt = "Enter the Maximum length of string." & _
vbCrLf & "Cannot be less than " & _
intMinLgth & " or more than " & _
intProgMax & "."

Do
intMaxLgth = Application.InputBox _
(strPrompt, _
Default:=8, _
Title:=strTitle, _
Type:=1)
If intMaxLgth = 0 Then
MsgBox "User cancelled." & vbCrLf & _
"Processing terminated."
Exit Sub
End If
Loop While intMaxLgth < intMinLgth Or _
intMaxLgth > intProgMax

lngRow = rngHeaderCell.Row
lngCol = rngHeaderCell.Column

'Clear any data from selected start cell to end of column
Range(rngHeaderCell, Cells(Rows.Count, lngCol)).Clear

rngHeaderCell = "Random Strings"
rngHeaderCell.Font.Bold = True

'Create the number of strings selected by user
For r = 1 To lngNumbStrgs

'Do Loop tests if string already exists and if
'it does then loop and create a new string.
intLoopCounter = 0
Do
intLoopCounter = intLoopCounter + 1
'Prevent eternal loop if cannot create
'non recurring strings
If intLoopCounter > 3 Then
MsgBox "Program is having problems creating" _
& " unique strings." & vbCrLf & vbCrLf _
& "Need to select longer strings for the" & _
" number of strings required." & vbCrLf & vbCrLf _
& "Processing will terminate."
Exit Sub
End If
'Initialize strToCreate with a
'random 1st character between A and Z.
strToCreate = _
Chr(WorksheetFunction.RandBetween(65, 90))

'Set random length of string between minimum
'and maximum selected by user.
If intMinLgth > 1 Then
intRandLgth = _
WorksheetFunction.RandBetween _
(intMinLgth, intMaxLgth) - 1
End If

'Concatenate random characters to string
For i = 1 To intRandLgth
'Add random character between a and z
strToCreate = strToCreate & _
Chr(WorksheetFunction.RandBetween(97, 122))
Next i

'Test if string already exists and if it does
'the loop and create another string.
Loop While WorksheetFunction.CountIf _
(Range(Cells(lngRow, lngCol), _
Cells(Rows.Count, lngCol).End(xlUp)), _
strToCreate) > 0

'Write random string to next empty cell.
Cells(Rows.Count, rngHeaderCell.Column) _
.End(xlUp).Offset(1, 0) = strToCreate
Next r

Columns(rngHeaderCell.Column).AutoFit
rngHeaderCell.Select
'******************************************

Next Program:
Creates an Id with 6 digit number.
Id Number is prefixed with workbook Id number.
First number will be X00001 where X is workbook Id from workbook name.

Open a new workbook and save it as FilenameX.xls (or .xlsm) where Filename
is any name and X is a numeric digit.
Enter the following in the work***:-
In cell A1 enter Id
In cell B1 enter First Name
In cell C1 enter Last Name

Right click the work*** tab name and select View Code.
Delete the default Private Sub / End Sub
Copy the code below (between the asterisk lines) into the VBA editor.
Close the VBA editor.
Save the workbook.

The code is event driven code that runs when a change is made in either
column B or column C.

Enter something in column B or C.
An Id will appear in column A.
Continue entering dummy data in columns B or C down the page.

If you edit an entry in column B or C where an Id already exists then the Id
remains unchanged.

If the workbook name contains more than one numeric then the Id is prefixed
with all numerics.
Delete any existing data under the column headers.
Save and close the file.
Rename the file but use 2 digits like 12 in the filename. (FilenameXX.xls).
Repeat the test.

It does not matter if the Id’s get out of order due to rearranging the
work***. The code looks for the Maximum number in column A and increments
that.

'***********************************************

'The following single Dim statement must remain
'in the Declarations area before any subs.
Dim strNumeric As String

Private Sub Worksheet_Change(ByVal Target As Range)

'Exit Sub 'Used to suppress event during testing

Dim lngTargCol As Long
Dim lngTargRow As Long
Dim dblIdNumb As Double
Dim i As Integer

lngTargCol = Target.Column
lngTargRow = Target.Row
strNumeric = "" 'Initialize to cancel previous value

'Only process if column A or B changed
If lngTargCol = 2 Or lngTargCol = 3 Then

'Create new Id number only if Id cell blank
If Cells(lngTargRow, "A") = "" Then

'Find maximum existing number in column and add 1
dblIdNumb = WorksheetFunction.Max(Range(Cells(2, "A"), _
Cells(Rows.Count, "A").End(xlUp))) + 1

'If Max + 1 = 1 then no existing Id numbers
'Therefore insert the first Id number
If dblIdNumb = 1 Then 'No existing numbers
Call CreateFirstNumb 'Find numeric in file name

'Convert string to numeric and add 1
dblIdNumb = Val(strNumeric) + 1 'Set to first number
End If

Cells(lngTargRow, "A") = dblIdNumb 'Copy to cell
End If
End If

End Sub

Sub CreateFirstNumb()

'This sub only used once to create the first Id Number
'Not used for successive Id numbers.

Dim strThisWbname As String
Dim i As Integer
Dim intIdDigits As Integer

intIdDigits = 6 'Modify for more or less digits

strThisWbname = ThisWorkbook.Name

'Create string from numeric in file name
For i = 1 To Len(strThisWbname)
If IsNumeric(Mid(strThisWbname, i, 1)) Then
strNumeric = strNumeric & Mid(strThisWbname, i, 1)
End If
Next i

'Confirm numerics exist in source file otherwise
'End the processing.
If IsNumeric(strNumeric) And _
Len(strNumeric) < intIdDigits Then 'valid if numeric
'Create 6 digit string commencing with numeric
'from the FileName.
'Note: It does not matter how many characters are _
'in the existing numeric provided it is < than intIdDigits
For i = 1 To intIdDigits
strNumeric = strNumeric & "0" 'Append zeros

'Stop when intIdDigits digits reached.
If Len(strNumeric) = intIdDigits Then Exit For
Next i
Else
MsgBox "Error! Either no numerics found in File name" & _
vbCrLf & "or too many numeric characters in File name." & _
vbCrLf & vbCrLf & "Maximum 5 numerics allowed in File name." & _
vbCrLf & vbCrLf & "Filename: " & strThisWbname & _
vbCrLf & vbCrLf & "Processing will terminate.", Title:= _
"Unsuitable File Name for creation of Id"

End
End If

End Sub

'********************************************

--
Regards,

OssieMac


.

Loading