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

[TraciAnn]

This was in a previous post but after thinking through the result of my
request, I realized I was asking the wrong question.

The goal:
Synchronize changes between a workbook distributed to multiple users and
either a separate workbook or another source to be imported into an Access
database.

The scenario:
I distribute a workbook that is maintained by outside sources (agents). The
workbook contains two tabs/sheets, “Location†and “Technicianâ€. The agents
change their workbooks daily and the changes need to be “reported†back to me
so the data can be massaged and imported into an Access database.

Worksheet “Location†contains mostly information which is maintained by me
and is protected/locked when the workbook is distributed. Location also
contains columns that are validated data using a list identified by a dynamic
named range on the Technician worksheet. These columns are not locked when
the worksheet is protected.

Worksheet “Technician†is maintained by field agents. They add and edit the
names and addresses of resources to Technician and then assign them to a
location on worksheet “Locationâ€.

Only one column is locked on the Technician worksheet. It is a formula that
creates a unique ID based on the input of some of the information in the
other columns.

Solution(s) needed:
1. The agent makes updates to the workbook throughout the day. A change to
any existing "record" (row) results in that row being "flagged" (probably a
value in a column) and any new rows added default to flagged.

2. When the agent is ready to submit their changes they invoke a command
that identifies the flagged records and exports them to a separate sheet or a
separate workbook then resets the flags on their original workbook.

The solution needs to keep in mind that there are two worksheets each
containing different information; where the changes of both need to be
processed.

 

[AltaEgo]

Is the spreadsheet mailed to you or do you have access over the LAN? If you
have direct access, why not link the worksheets direct to Access and create
a "processed = TRUE" flag after performing append query/s? Otherwise, you
be able to obtain most of you VBA code here:

http://www.rondebruin.nl/copy5_2.htm


You should be able to record most of your autofilter code using the macro
recorder. You may need to be able to determine whether autofilter is on or
off. To do this, see AutoFilterMode in VBA help. (Ron shows you how to turn
autofilter on/off is his code).

In suggesting the above, I made the assumption that you understand the
basics of VBA. If my assumption is wrong, and/or you need further help,
please ask.

 

[OssieMac]

Hi again TraciAnn,

As you requested I have sort out your new post.

As per my answer to your previous post I still think that it is necessary to
keep a Master copy of the data on a hidden and protected sheet and when it is
time to create the report of the changed records, run code similar to my
previous code but set a flag in a column for the changed records. Code can
then loop through the flags and copy the changed records to another workbook.

NOTE: When using an extra column for the flags, UsedRange is not really
appropriate. Better to assign the required range to a variable otherwise the
flag column will appear to be a change.

The flags could be inserted each time a change is made using worksheet
change event. However, if a user inadvertantly changes something and then
realizes they have changed an incorrect record and they revert the record
back to original then the worksheet change event will flag it as an update
when it really isn't.

The sample code below is an extended version of my previous answer.
Basically what is does is:-
Tests for changes.
Sets the flag in a separate column for changed records.
Creates a new workbook.
Names the workbook.
Creates a name for the workbook incorporating current date.
Saves the new workbook with the new name.
Names the first worksheet in the new workbook .
Copies the changed records to the new workbook.
Re-saves the new workbook and closes it.

I have only written code for one worksheet because if you need code for a
second one then it will be similar. I have included a number of comments to
help you understand what is occurring. However, feel free to get back to me
with questions.

Sub TestForChanges()

Dim wsMysheet As Worksheet
Dim wsMastCopy As Worksheet
Dim c As Range
Dim rngData As Range
Dim flagCol As String
Dim lastDataCol As String

Dim strReportName As String
Dim strPath As String
Dim wbReport
Dim wsDaily As Worksheet

'Edit "K" to last column of data (excluding flag column)
lastDataCol = "K"

'Edit "M" to your column for update flags
flagCol = "M"

Set wsMysheet = Sheets("My Sheet")
Set wsMastCopy = Sheets("Master Copy")

'Clear any existing Update flags
wsMysheet.Range(Cells(2, flagCol), _
Cells(Rows.Count, flagCol).End(xlUp)) _
.ClearContents

'Set flag for records updated.
With wsMysheet
Set rngData = .Range(.Cells(2, 1), _
.Cells(.Rows.Count, lastDataCol).End(xlUp))

'Edit "A1:K20" to your range
For Each c In rngData
If c.Value <> wsMastCopy.Range(c.Address) Then
.Cells(c.Row, flagCol) = "Update"
End If
Next c
End With

'Copy updated records to a report file

'Save required path for Report workbook
strPath = CurDir & "\"

'Create report name with path, workbook name
'and date in y/m/d format.
strReportName = strPath & "Report " & _
Format(Date, "yyyy-mm-dd") & ".xls"

Workbooks.Add 'Create new report workbook

'Save the new report workbook (Excel 97-2003 format)
ActiveWorkbook.SaveAs Filename:=strReportName

'Assign Report workbook to a variable
Set wbReport = ActiveWorkbook

'Name the first worksheet in the report workbook
With wbReport
.ActiveSheet.Name = "Daily Update"
'Assign worksheet to a variable
Set wsDaily = .ActiveSheet

'Copy column headers from original worksheet
wsMysheet.Range("A1:K1").Copy _
Destination:=wsDaily.Cells(1, 1)
End With

With wsMysheet
'Edit "M" to your column for flags
For Each c In .Range(.Cells(2, flagCol), _
.Cells(.Rows.Count, flagCol).End(xlUp))

'Loop through the cells with Update and
'copy updated rcords to Report workbook
If c.Value = "Update" Then
.Range(c.Offset(0, -12), c.Offset(0, -2)).Copy _
wsDaily.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
End If
Next c
End With

wbReport.Activate
ActiveWorkbook.Save
ActiveWindow.Close

End Sub

 

[TraciAnn]

Ossie,

Thank you so much for your easy to read clarification of your code. That is
awesome!

I've studied through your post and I'm just about ready to test but I do
have a few questions:

First, I assume your code is copy/paste with a few small edits.

Second, I assume I paste it into the sheets vba code (right click>>view code)

If these assumptions are correct, then:

'Edit "A1:K20" to your range
For Each c In rngData
If c.Value <> wsMastCopy.Range(c.Address) Then
.Cells(c.Row, flagCol) = "Update"
End If

1. I don't find any reference to A1:K20 in your code. Regardless, there are
two sheets in the workbook and both ranges would need to be dynamic.
Technician changes considerably and Location, although it doesn't change in
length by much, it is vulnerable to size changes. From what I can tell, it
appears that you have removed the fixed range (e.g. A1:K20). Correct?

2. It is unclear to me the actual UI of this. I assume everything is hidden
from the field agents. But it appears that the code is distributed in the
agents' copies. Correct?

3. How is the code executed once I receive the workbooks from the field?

I'm sorry to be so naive. Your help is not taken for granted.

Sincerely,
TraciAnn

 

[OssieMac]

Hi TraciAnn,

The code will either run in a standard module or in the Sheets VBA code
module.

I initially wrote the code with the idea that it would provide you with a
starting point and I assumed that you would be able to modify it as necessary
for your application. From the questions you have asked I am now wondering if
your knowledge of VBA is limited and you will need further assistance to
implement it. How accurate is this assumption?

Firstly answering your questions.

1(a) Your question: “I don't find any reference to A1:K20 in your codeâ€
My apologies for that. Initially I wrote the code using a fixed range and
later changed it to make it more dynamic so you only need to edit the code
for last column Id of the data plus the column Id where you want to insert
Update flag and I forgot to remove the comment.

1(b) Your question: “two sheets in the workbook and both ranges would need
to be dynamicâ€.
The existing code is dynamic for the number of rows assuming that row one is
for column headers and data starts at cell A2. You need to provide the last
column Id for the data.

1(c) Your question: “From what I can tell, it appears that you have removed
the fixed range (e.g. A1:K20)â€.
Correct as per previous explanation. rngData takes its place as a more
dynamic range. (If you understand this perhaps you are more advanced than I
gave you credit for above.)

2. Your Question: “It is unclear to me the actual UI of this. I assume
everything is hidden from the field agents. But it appears that the code is
distributed in the agents' copiesâ€.
The code was designed to be in the agents copies because I thought that the
idea was that they would run it and only send you a report.
However, how do you prefer it; in the agents workbook or in a separate
workbook?
If the agents return their workbook to you and you run the code then I
suggest a separate workbook.
Also if you run the code then the Master copy can be made very hidden and
cannot be unhidden in the interactive mode.

3. Your question: “How is the code executed once I receive the workbooks
from the field?â€
I’ll explain when I know what version of Excel you are using. (See my
questions below.)

So that I can continue to provide you with further assistance as required
perhaps you can answer the following questions for me.

1. What version of Excel are you using? (Code should work in any version but
easier to give you instructions for implementing if I know what version you
are using.)
2. What is the name of your workbook? (Might as well use the correct names
for workbook and worksheets when developing the code.)
3. What are the names of the worksheets?
4. Is it only the number of rows that is dynamic or can the number of
columns also change?
5. If the number of columns is static, what is the Id of that column?
6. If the number of columns is not static, then can I assume there always be
column headers in row one for the full number of columns? (Can use to find
the last column)
7. To be sure of using the correct range for the rows I need to know a
column that will always have data in every row. (Sometimes records can have
blank fields and those columns are not suitable for finding the last row.)
8. For the 2 sheets of data output, do you want them on separate worksheets
in the same report workbook or in separate workbooks?
9.What name should be given to each of the output report worksheets.
9. Is the naming convention “Report yyyy-mm-dd.xls†for the report workbook
satisfactory?

I will attempt to continue to advise you until you have it up and running.

 

[OssieMac]

Hi again TraciAnn,

Thought of another question. I see that I had question 9 used twice in
previous post so made this one 11.

11. If you want a separate workbook for the code, can the Source WorkBook,
Report WorkBook and the Code WorkBook all be in the same Folder (Directory)?
If not, then I can make allowance for separate paths otherwise will just use
the one path.

By the way you are not naive. You are learning. We all had to start somewhere.

 

[TraciAnn]

OssieMac,

Thank you so much for your help. I lose sleep over this project and this
spreadsheet is in my dreams (nightmares). If I can get this spreadsheet
locked down, life will be much easier. The experts on this site are so
wonderful, I can't wait for the day when I'm actually able to give a little
rather than take allot <grin>

Answers to your questions are inline...

From the questions you have asked I am now wondering if
your knowledge of VBA is limited and you will need further assistance to
implement it. How accurate is this assumption?

<grin> I'm a VBA newbie (sorry)
but I'm a quick study and I don't scare easy. (I'm also certified MOS Expert
in Excel)

Firstly answering your questions.
The code was designed to be in the agents copies because I thought that the
idea was that they would run it and only send you a report.
However, how do you prefer it; in the agents workbook or in a separate
workbook?
If the agents return their workbook to you and you run the code then I
suggest a separate workbook.
Also if you run the code then the Master copy can be made very hidden and
cannot be unhidden in the interactive mode.

Since I don’t have a handle on the capabilities I’m not sure how to answer
this. My main objective is to “lock down†the spreadsheet so agents are very
limited to what data they can add/edit/delete and that I receive, and can
easily identify all changes to the workbook.

I don’t like to answer questions with questions but "what works best given
my objective?"

My initial description of what is needed is framed by my limited knowledge.
In the hands (or brain) of someone who knows how to make Excel sing and make
coffee in the morning, the frame would be of much different proportions.

1. What version of Excel are you using? (Code should work in any version but
easier to give you instructions for implementing if I know what version you
are using.)

2007 but saving in ’03 format (agents are using combination ’03 and ’07)

2. What is the name of your workbook? (Might as well use the correct names
for workbook and worksheets when developing the code.)

TechAssignment[1].xls (where [1] is the corresponding id to the agent from
whom the workbook came).

3. What are the names of the worksheets?

“Location†and “Technicianâ€

4. Is it only the number of rows that is dynamic or can the number of
columns also change?

The column range on both sheets are fixed – as far as the user goes; my boss
can’t make up his mind what information he has to have so I end up adding or
deleting a row between each update. I don’t think it matters but not all
columns are utilized by every record (row) in Location. The last eight
columns are populated by technicians based on how many techs are needed. Most
locations will only use 4 of the last 8 columns.

5. If the number of columns is static, what is the Id of that column?

Currently Location is $A:$S and Technician is $A:$M

6. If the number of columns is not static, then can I assume there always be
column headers in row one for the full number of columns? (Can use to find
the last column)

Yes. Common convention for me.

7. To be sure of using the correct range for the rows I need to know a
column that will always have data in every row. (Sometimes records can have
blank fields and those columns are not suitable for finding the last row.)

This is something additional you might be able to help with.
$B and $C (FirstName and LastName) are required. The agent doesn't always
have one or the other and ends up leaving one blank. The first column ($A) is
currently a formula that concatenates values from other columns. I would
prefer to change this so $A generates a unique ID that I can also use in the
db. The ID can be sequential with one exception, the ID has to be unique
across all workbooks. The agent # can be used as a prefix (e.g.
TechAssignment1.xls would produce ID's of 100001, TechAssignment2.xls -
200002, etc.) If I knew how, I would use VBA to look to see if a name has
been entered, if so, then generate an ID.

If the ID is accomplished, of course, $A would have a value for every valid
row.

8. For the 2 sheets of data output, do you want them on separate worksheets
in the same report workbook or in separate workbooks?

I believe it will be easier to manage with fewer objects so, Same Workbook.

9. What name should be given to each of the output report worksheets.
Is the naming convention “Report yyyy-mm-dd.xls†for the report workbook
satisfactory?

“TechAssignment[1] yymmdd.xls†would be consistent with my naming
conventions where [1] is the Agent number that is in the name of the original
workbook. (Amazing it is so similar to your suggested name!!!)

I will attempt to continue to advise you until you have it up and running.

OssieMac...Thank you so much! You are AWESOME!!!

 

[OssieMac]

OK TraciAnn I will work towards your spec. Don't panic if it is a day or so
before I get back to you because I will be interrupted with a couple of other
things that I have to do.

--
Regards,

OssieMac

OssieMac,

Thank you so much for your help. I lose sleep over this project and this
spreadsheet is in my dreams (nightmares). If I can get this spreadsheet
locked down, life will be much easier. The experts on this site are so
wonderful, I can't wait for the day when I'm actually able to give a little
rather than take allot <grin>

Answers to your questions are inline...

From the questions you have asked I am now wondering if
your knowledge of VBA is limited and you will need further assistance to
implement it. How accurate is this assumption?

<grin> I'm a VBA newbie (sorry)
but I'm a quick study and I don't scare easy. (I'm also certified MOS Expert
in Excel)

Firstly answering your questions.
The code was designed to be in the agents copies because I thought that the
idea was that they would run it and only send you a report.
However, how do you prefer it; in the agents workbook or in a separate
workbook?
If the agents return their workbook to you and you run the code then I
suggest a separate workbook.
Also if you run the code then the Master copy can be made very hidden and
cannot be unhidden in the interactive mode.

Since I don’t have a handle on the capabilities I’m not sure how to answer
this. My main objective is to “lock down†the spreadsheet so agents are very
limited to what data they can add/edit/delete and that I receive, and can
easily identify all changes to the workbook.

I don’t like to answer questions with questions but "what works best given
my objective?"

My initial description of what is needed is framed by my limited knowledge.
In the hands (or brain) of someone who knows how to make Excel sing and make
coffee in the morning, the frame would be of much different proportions.

1. What version of Excel are you using? (Code should work in any version but
easier to give you instructions for implementing if I know what version you
are using.)

2007 but saving in ’03 format (agents are using combination ’03 and ’07)

2. What is the name of your workbook? (Might as well use the correct names
for workbook and worksheets when developing the code.)

TechAssignment[1].xls (where [1] is the corresponding id to the agent from
whom the workbook came).

3. What are the names of the worksheets?

“Location†and “Technicianâ€

4. Is it only the number of rows that is dynamic or can the number of
columns also change?

The column range on both sheets are fixed – as far as the user goes; my boss
can’t make up his mind what information he has to have so I end up adding or
deleting a row between each update. I don’t think it matters but not all
columns are utilized by every record (row) in Location. The last eight
columns are populated by technicians based on how many techs are needed. Most
locations will only use 4 of the last 8 columns.

5. If the number of columns is static, what is the Id of that column?

Currently Location is $A:$S and Technician is $A:$M

6. If the number of columns is not static, then can I assume there always be
column headers in row one for the full number of columns? (Can use to find
the last column)

Yes. Common convention for me.

7. To be sure of using the correct range for the rows I need to know a
column that will always have data in every row. (Sometimes records can have
blank fields and those columns are not suitable for finding the last row.)

This is something additional you might be able to help with.
$B and $C (FirstName and LastName) are required. The agent doesn't always
have one or the other and ends up leaving one blank. The first column ($A) is
currently a formula that concatenates values from other columns. I would
prefer to change this so $A generates a unique ID that I can also use in the
db. The ID can be sequential with one exception, the ID has to be unique
across all workbooks. The agent # can be used as a prefix (e.g.
TechAssignment1.xls would produce ID's of 100001, TechAssignment2.xls -
200002, etc.) If I knew how, I would use VBA to look to see if a name has
been entered, if so, then generate an ID.

If the ID is accomplished, of course, $A would have a value for every valid
row.

8. For the 2 sheets of data output, do you want them on separate worksheets
in the same report workbook or in separate workbooks?

I believe it will be easier to manage with fewer objects so, Same Workbook.

9. What name should be given to each of the output report worksheets.
Is the naming convention “Report yyyy-mm-dd.xls†for the report workbook
satisfactory?

“TechAssignment[1] yymmdd.xls†would be consistent with my naming
conventions where [1] is the Agent number that is in the name of the original
workbook. (Amazing it is so similar to your suggested name!!!)

I will attempt to continue to advise you until you have it up and running.

OssieMac...Thank you so much! You are AWESOME!!!

 

[TraciAnn]

OssieMac,

I forgot to answer this one.

11. If you want a separate workbook for the code, can the Source WorkBook,
Report WorkBook and the Code WorkBook all be in the same Folder (Directory)?
If not, then I can make allowance for separate paths otherwise will just use
the one path.

I'm not sure I understand this fully. The agents do not have any access to
my network. Therefore, their copies will be standalone.

As far as anything I work with, yes. It won't be a problem to keep them all
in a common folder.

By the way you are not naive. You are learning. We all had to start somewhere.

Thank you for the encouragement!!!

 

[OssieMac]

OK TracieAnn. Ready for you to do some preliminary testing. It will need more
work but I would like to know if I am working in the right direction.

Philosophy is as follows:-

Separate workbook to hold the VBA code.
All files to be in the one Folder. (Best to create a folder for the purpose).
Uses FileOpen Dialog for the user to select the required TechAssignmentX.xls
workbook.
Copies the worksheets Location and Technician from the TechAssignment
workbook to temporary worksheets in the VBA code workbook. (I believe it is
good policy to try not to manipulate the original source data. Make a copy of
the source and alter the copy.)
Creates a report with naming convention Report_X yyyy-mm-dd where X is the
number from the TechAssignmentX.xls workbook. (The number can be any number
of characters long.)
The Report workbook has 2 worksheets; Location Update and Technician Update.


Guide to get started:
SORRY FOR SHOUTING BUT ENSURE THAT YOU ONLY USE COPIES OF YOUR PRECIOUS DATA
FILES FOR THE TESTING.

Because you said you are using XL2007 and I understand that you will be
running the macros, the Instructions are for XL2007. (The
TechnicianAssignment workbooks will be 97-2003 format)

Create a special folder for this project.
Open Excel and set options security to allow macros. To do this:-
Microsoft Button -> Excel Options -> Trust Center -> Trust Center Settings
-> Macro Settings .
Select Disable all macros with notification.
Check the box Trust access to the VBA project object model.
While this dialog is still open, the next part is optional.
Select Trusted locations and add the new folder to the trusted locations.
This way you do not have to continually approve the macro to run every time
you open it.
Close Options.

Open a new workbook.
Name the 1st sheet ‘Main Menu’
Name the 2nd sheet ‘Temp Location’
Name the 3rd sheet ‘Temp Technician’
Note: the worksheet names must be entered accurately.
Save the workbook in the new folder.

Select sheet Main Menu

Click Developer ribbon.
Click the down pointing arrow at the bottom of Insert button in the Controls
block.
The resulting dialog shows both Form Controls and ActiveX controls.
Form controls are old hat for backward compatibility so forget they exist.
Click Command button (ActiveX control). Cursor control becomes a cross (+)
Click on the worksheet where you want the button and hold the mouse button
and drag to create a command button.
Note that the Design Mode button has turned orange. (Leave as is for now.)
Right click the new command button.
Select properties.
Change (Name) property from CommandButton1 to RunUpdate (No spaces)
Change Caption property from CommandButton1 to Create Update Reports (or any
other caption you prefer on the button. Spaces allowed.)
Close properties.
Right click the button again. (Design Mode button must still be Orange)
Select View Code. (VBA Editor will open).
The Private Sub and End Sub for the button click event is displayed. (do not
change the sub name)
Insert Call CreateChangeReports between the Private Sub and End Sub lines.
Should now look like this:-

Private Sub RunUpdate_Click()
Call CreateChangeReports
End Sub

While the VBA editor is open Select menu item Insert -> Module and a new
module will open.
Copy all the following code and comments between the asterisk lines into the
module.

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

'The following single Dim statement must remain
'in the Declarations area where it is (before any subs.)
Dim wbSource As Workbook

Sub CreateChangeReports()

'These Dim statements remain inside the sub.
Dim wbReport As Workbook

Dim wsSource1 As Worksheet
Dim wsSource2 As Worksheet

Dim wsMast1 As Worksheet
Dim wsMast2 As Worksheet

Dim wsReport1 As Worksheet
Dim wsReport2 As Worksheet

Dim intShtDefault As Integer

Dim strSourcePath As String
Dim strReportPath As String
Dim strSourceMask As String
Dim strReportName As String
Dim strTestReportName As String

Dim varResponse As Variant

Dim c As Range
Dim rngData As Range

Dim i As Integer
Dim strNumeric As String

'Can change the following 2 lines to any valid path
'(For development all workbooks in same path)
strSourcePath = ThisWorkbook.Path & "\"
strReportPath = ThisWorkbook.Path & "\"

'Create filtering mask for OpenFiledialog
'Using .xl* in lieu of .xls or .xlsx
'works with both xl2007 and earlier versions
strSourceMask = strReportPath & "TechAssignment*.xl*"

'Call sub to display OpenFile dialog
Call OpenWorkbook("Select Source File", _
strSourceMask)

With wbSource
Set wsSource1 = .Sheets("Location")
Set wsSource2 = .Sheets("Technician")
Set wsMast1 = .Sheets("Mast Location")
Set wsMast2 = .Sheets("Mast Technician")
End With

With ThisWorkbook 'The workbook with code
'Clear the temporary data sheets
.Sheets("Temp Location").Cells.Clear
.Sheets("Temp Technician").Cells.Clear

'Copy the source data to temporary data sheets
wsSource1.UsedRange.Copy _
Destination:=.Sheets("Temp Location") _
.Cells(1, 1)

wsSource2.UsedRange.Copy _
Destination:=.Sheets("Temp Technician") _
.Cells(1, 1)

'Reassign the source worksheet variables
'to temp worksheet names of Thisworkbook.
Set wsSource1 = .Sheets("Temp Location")
Set wsSource2 = .Sheets("Temp Technician")
End With

'Set the Update flags for first worksheet
Call SetFlags(wsSource1, wsMast1)

'Set the Update flags for second worksheet
Call SetFlags(wsSource2, wsMast2)

'Create report name with incl Path, WorkbookName,
'Numeric Id, and date in Path\Report# yyyy-mm-dd format.

'Find the numerics in the Source file name and
'save to string variable for use in Report Name.
strNumeric = ""
For i = 1 To Len(wbSource.Name)
If IsNumeric(Mid(wbSource.Name, i, 1)) Then
strNumeric = strNumeric & Mid(wbSource.Name, i, 1)
End If
Next i

'Confirm numerics exist in source file otherwise
'exit the processing.
If IsNumeric(strNumeric) Then 'Valid if contains numeric
strNumeric = strNumeric & " " 'Add a space
Else
MsgBox "error. No numerics found in Source" & _
vbCrLf & "Filename: " & wbSource.Name & _
vbCrLf & "Processing will terminate"
Exit Sub
End If

'Concatenate strings to create the Report name
strReportName = strReportPath & "Report" & _
strNumeric & Format(Date, "yyyy-mm-dd") & ".xlsx"

strTestReportName = Dir(strReportName)

If Len(strTestReportName) > 0 Then
varResponse = MsgBox("Following Report exists:-" _
& vbCrLf & strTestReportName & vbCrLf _
& "Do you want to overwrite it?", vbYesNo)

If varResponse = vbNo Then
wbSource.Close SaveChanges:=False
Exit Sub
End If
End If

'Save users existing Default # WorkSheets for new workbooks
intShtDefault = Application.SheetsInNewWorkbook

'Set default # WorkSheets ready for new workbook
Application.SheetsInNewWorkbook = 2

'Create new report workbook and assign to variable
'in single line of code.
Set wbReport = Workbooks.Add

'Reset the Users default # WorkSheets for new workbooks
Application.SheetsInNewWorkbook = intShtDefault

With wbReport
'Save the new report workbook.
Application.DisplayAlerts = False
.SaveAs Filename:=strReportName
Application.DisplayAlerts = True

'Name the worksheets.
.Sheets(1).Name = "Location Update"

.Sheets(2).Name = "Technician Update"

'Assign worksheets to variables.
Set wsReport1 = .Sheets("Location Update")
Set wsReport2 = .Sheets("Technician Update")

'Copy the column headers from first Source
'Data worksheet to first worksheet in report.
With wsSource1
.Range(.Cells(1, 1), .Cells(.Columns.Count) _
.End(xlToLeft)).Copy _
Destination:=wsReport1.Cells(1, 1)
End With

'Copy the column headers from second Source
'Data worksheet to second worksheet in report.
With wsSource2
.Range(.Cells(1, 1), .Cells(.Columns.Count) _
.End(xlToLeft)).Copy _
Destination:=wsReport2.Cells(1, 1)
End With

End With

'Copies the Updated records to the report.

Call CopyUpdatesToReport(wsSource1, wsReport1)

Call CopyUpdatesToReport(wsSource2, wsReport2)

'____________________________________________

'Need to find out what needs to be done with
'the source workbook after reporting completed
'and insert any required code here.
'_____________________________________________

'Close workbooks and cleanup
wbSource.Close SaveChanges:=False
'Clear the assigned variable
Set wbSource = Nothing

wbReport.Save
wbReport.Close
Set wbReport = Nothing

MsgBox "Report has been generated and saved as:" _
& vbCrLf & vbCrLf & strReportName

End Sub


Sub OpenWorkbook(myTitle As String, _
strInitSource As String)

Dim strFile As String
Dim strShortname As String
Dim fd As FileDialog

Set fd = Application.FileDialog(msoFileDialogFilePicker)

With fd
.InitialView = msoFileDialogViewDetails
.AllowMultiSelect = False
.InitialFileName = strInitSource
.Title = myTitle
If .Show = False Then
Exit Sub
End If
strFile = .SelectedItems(1)
End With

'Remove path and assign workbook name to string variable
strShortname = Right(strFile, Len(strFile) _
- InStrRev(strFile, "\"))

Set wbSource = Nothing
On Error Resume Next
Set wbSource = Workbooks(strShortname)
On Error GoTo 0

'Following turns off macro protection
'to open workbook if required.
If wbSource Is Nothing Then
Application.AutomationSecurity _
= msoAutomationSecurityLow

Set wbSource = Workbooks.Open _
(strFile, UpdateLinks:=False, _
ReadOnly:=False)

'Turn macro protection back on.
Application.AutomationSecurity _
= msoAutomationSecurityByUI
End If

End Sub

Sub SetFlags(wsSource As Worksheet, _
wsMast As Worksheet)
Dim lastCol As Long
Dim flagCol As Long
Dim rngData As Range
Dim c As Range

'Sets flag for records updated.
With wsSource
'Find last column of data.
lastCol = .Cells(1, .Columns.Count) _
.End(xlToLeft).Column

'Set flag column as next column.
flagCol = lastCol + 1

'Clear any existing Update flags.
.Range(.Cells(1, flagCol), _
.Cells(.Rows.Count, flagCol).End(xlUp)) _
.Clear

Set rngData = .UsedRange 'Actual data range.

'Set the Update flags.
For Each c In rngData
If c.Value <> wsMast.Range(c.Address) Then

.Cells(c.Row, flagCol) = "Update"
End If
Next c
End With

End Sub

Sub CopyUpdatesToReport(wsSource As Worksheet, _
wsReport As Worksheet)

Dim lastCol As Long
Dim flagCol As Long
Dim c As Range

With wsSource
'Find last column header and save column number.
lastCol = .Cells(1, .Columns.Count) _
.End(xlToLeft).Column

'Assign next column number for Update Flag column
flagCol = lastCol + 1

For Each c In .Range(.Cells(2, flagCol), _
.Cells(.Rows.Count, flagCol).End(xlUp))

If c.Value = "Update" Then
.Range(.Cells(c.Row, 1), _
.Cells(c.Row, lastCol)).Copy _
wsReport.Cells(Rows.Count, "A") _
.End(xlUp).Offset(1, 0)
End If
Next c
End With

End Sub

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

Close the VBA editor. Click the Cross with the RED background far top right.
(Not the cross under it which will only close individual modules)

Click the Design Mode button to turn off Design Mode. (Note it is Orange
when in design mode and just the blue background when turned off).

If you later want to change properties of the button such as colors etc then
you need to turn Design Mode on and then right click the button again.

If you need to open the VBA editor again then Alt/F11 toggles between the
worksheet and the VBA Editor. Select the appropriate module from the Project
Explorer on the left of the screen. (If can’t see Project Explorer then
Ctrl/R displays it or via the View menu.)

Save the workbook as a MACRO ENABLED workbook using any name you prefer.

Copy 3 or 4 of your TechAssignment workbooks into the folder for testing.

On each of the TechAssignment workbooks create the following 2 additional
worksheets.
Mast Location
Mast Technician

In each TechAssignment workbook do the following:-
Select all cells on worksheet Location and copy.
Paste Special -> Values to Mast Location.

Select all cells on worksheet Technician and copy.
Paste Special -> Values to Mast Technician.

Don’t worry about hiding or protecting these worksheets at this stage. We
need to test first and worry about the rest later. I will include Hiding and
Protection in the code when I know what needs to be done after the Reports
are run.

Make a few dummy changes to Location and Technician worksheets in each
workbook and then close them.

Click the button the on the Main Menu worksheet to run the code.
Select the required TechAssignment to process.
After code has run you will get a message giving you file details of the
report.
Check the report and see if it is what you expect.

If you run a specific report multiple times on the same day then you will
get a message asking if you want to overwrite the previous one. You can
either select Yes to overwrite it or select No and the processing will
terminate. If you terminate then you can rename the old report so you can
keep it and then run the report again.

I hope we are going in the right direction. (I think it has taken nearly as
long to write the instructions as writing the code.)

 

[TraciAnn]

Good News....Bad News...More Good News

First, thank you so much for your detail. I know that can be such a bother.
You do a remarkable job of making sure I understand.

First "Good News":
To help with your efforts, you can reduce the detail a degree or two. If it
deals with typical app things (Close button, Save As, Excel Options, Security
Options) I'm pretty familiar with that.

I've also done a little bit of VBA in Access. Only to the extent of changing
object properties and things. I definitely could not even figure out the code
you provided.

Anyway, that should help with some of the "detail".

More Good Following everything to the letter, I was able to produce the reports and
"Yes" we are on the right track.

Bad Running the report wasn't that much of a problem, although it did take a
little while (90 secs). However, when I open the resulting Report1
2009-04-29.xlsx, it locks the system. I let the system stand for 10 minutes
just in case it was processing but nothing but a grey window and an hour
glass. I had to kill the process through task manager.

On another attempt of opening the report I was able to kill the process then
it opened a blank workbook with recovered reports in the navigation pane. I
was able to open those reports and see two worksheets with the changes I made
to the originals.

I hope I'm providing the information you want. Am I leaving out any detail?

Thanks OssieMac!!!

 

[OssieMac]

Hi TraciAnn,

How many time did you test? Wondering if maybe just one of those things that
happen occassionally.

Only clutching at straws to find an answer to the problems. The processing
is all fairly straight forward and I would not have thought it would cause
problems. Try the following:-

Restart your computer and run it without anything else running.

If you still have the problem, open Task manager and check if you have
multiple processes of Excel.exe. (Indicates some objects might not be reset
to nothing but at the moment I can't find any.)

I will be out for a few hours now so won't get back to you again for a while.

 

[TraciAnn]

Hi OssieMac!

How many time did you test? Wondering if maybe just one of those things that
happen occassionally.

Several times. The report is created correctly each time. The only problem
is when I go to open the ReportX file. Even opening from a fresh boot locks
the program requiring EndTask.

Once I open the system recovered report file I'm able to see the changes.
I'm also able to see them on the Temp Technician and Temp Locaiton sheets in
the Master file.

I will be out for a few hours now so won't get back to you again for a while.

All is good! Thank you so much for your help!

 

[OssieMac]

Hellow again TraciAnn,

A couple more things to try. Not sure if they will fix the problem but we
have to start somewhere.

Because of your answer in a previous post I assume that you are running this
using xl2007 with the TechAssignmentX.xls in compatibility mode.

I don't suppose that you have your default save file type set to 97-2003
file type because I did not include all the parameters in the SaveAs. Anyway
whether you have or not lets include all the SaveAs parameters. It's probably
good programming anyway and I am just wondering if in some cases they are
needed.

Open the VBA editor and select the Module with the code.

Use Edit -> Find and then find SaveAs to locate the following line of code.

.SaveAs Filename:=strReportName

Replace the above line with the following code that includes the SaveAs
parameters.

.SaveAs Filename:=strReportName, _
FileFormat:=xlOpenXMLWorkbook, _
CreateBackup:=False

(Just for interest, the space and underscore at the end of a line is a line
break in an otherwise single line of code.)

If the above does not work the try the following:-

I am wondering if there is spurious contents like formatting or something in
the unused area of the worksheets.

Open one of your TechAssignmentX.xls workbooks and unprotect the worksheets.

Open the VBA Editor (Alt/F11)

Insert a module.

Copy the following code into the module.


Sub TestUsedRange()

Sheets("Location").Select
ActiveSheet.UsedRange.Select

Sheets("Technician").Select
ActiveSheet.UsedRange.Select

End Sub

Run the code. You can run it from within the VBA Editor by clicking anywhere
within the Sub and press F5.

Change windows to the worksheets and check the area selected on the Location
and Technician worksheets. Does the selected area only include the data or
does it includes ranges outside the actual data?

If it includes ranges outside the actual data then do the following:-

Select all the columns to the right of the data and Clear All to ensure no
formatting or anything is in the unused cells. Note that simpy Clear or
deleting the columns does not necessarily Clear All. Must use the Clear All
from the editing block of the Home Ribbon.

Repeat for all the rows below the last row of data.

Do the above for all the worksheets Location, Technician, Mast Location and
Mast Technician.

Re-run the test macro and see if it now only selects the data.

To delete the macro, open or change to the VBA Editor and Right click the
Module in the Project Explorer then Remove Module. (answer No to export etc.)

Save and close the workbook and run the reports code again.

It this last part solves any problems then I will use a different method of
establishing the last row. (Can already use the column headers to establish
the last column.)

Also I realize that I did not name your reports as you requested. (Must have
been having one of my Seniors Moments that my son says I suffer from.) I will
fix that up.

Lastly. How many rows of data are in each of the worksheets? Makes it better
if I emulate the number of rows for testing purposes and I get a better idea
of how long the code takes to run.

Like I said before, I will persevere and try to get it working for you.

 

[OssieMac]

Hi again TraciAnn,

After re-reading your reply to my question I am now wondering if you want
all the files in XL97-2003 format. My code was saving the reports in XL2007
format.

If you want the reports in XL97-2003 format then you can replace all of your
code with the following (easier than you trying to edit the specific lines)
and it will work in either XL2002, XL2003 or XL2007. Have also changed the
report names to TechAssignmentX.xls.

Just copy all the code into the Module as before. You should not have to use
a new workbook; just put it in the one you already have in lieu of the old
code.

'*********************************************
'The following single Dim statement must be
'in the Declarations area before any subs.
Dim wbSource As Workbook

Sub CreateChangeReports()

'These Dim statements remain inside the sub.
Dim wbReport As Workbook

Dim wsSource1 As Worksheet
Dim wsSource2 As Worksheet

Dim wsMast1 As Worksheet
Dim wsMast2 As Worksheet

Dim wsReport1 As Worksheet
Dim wsReport2 As Worksheet

Dim intShtDefault As Integer

Dim strSourcePath As String
Dim strReportPath As String
Dim strSourceMask As String
Dim strReportName As String
Dim strTestReportName As String

Dim varResponse As Variant

Dim c As Range
Dim rngData As Range

Dim i As Integer
Dim strNumeric As String

'Can change the following 2 lines to any valid path
'(For development all workbooks in same path)
strSourcePath = ThisWorkbook.Path & "\"
strReportPath = ThisWorkbook.Path & "\"

'Create filtering mask for OpenFiledialog
'Using .xl* in lieu of .xls or .xlsx
'works with both xl2007 and earlier versions
strSourceMask = strReportPath & "TechAssignment*.xl*"

'Call sub to display OpenFile dialog
Call OpenWorkbook("Select Source File", _
strSourceMask)

With wbSource
Set wsSource1 = .Sheets("Location")
Set wsSource2 = .Sheets("Technician")
Set wsMast1 = .Sheets("Mast Location")
Set wsMast2 = .Sheets("Mast Technician")
End With

With ThisWorkbook 'The workbook with code
'Clear the temporary data sheets
.Sheets("Temp Location").Cells.Clear
.Sheets("Temp Technician").Cells.Clear

'Copy the source data to temporary data sheets
wsSource1.UsedRange.Copy _
Destination:=.Sheets("Temp Location") _
.Cells(1, 1)

wsSource2.UsedRange.Copy _
Destination:=.Sheets("Temp Technician") _
.Cells(1, 1)
End With
'Kill the original source ws variables
Set wsSource1 = Nothing
Set wsSource2 = Nothing

'Reassign the source worksheet variables
'to temp worksheet names of Thisworkbook.
With ThisWorkbook 'The workbook with code
Set wsSource1 = .Sheets("Temp Location")
Set wsSource2 = .Sheets("Temp Technician")
End With

'Set the Update flags for first worksheet
Call SetFlags(wsSource1, wsMast1)

'Set the Update flags for second worksheet
Call SetFlags(wsSource2, wsMast2)

'Create report name incl Path, WorkbookName,
'and date in Path\TechAssignment# yyyy-mm-dd format.

'Assign the portion of source file name which is
'left of the .xls to a variable.
strReportName = Left(wbSource.Name, InStr(1, wbSource.Name, ".") - 1)

'Concatenate the Report path and file name
strReportName = strReportPath & strReportName & _
" " & Format(Date, "yyyy-mm-dd") & ".xls"

'Perform a Dir on the proposed report name
strTestReportName = Dir(strReportName)

'If Dir found report then report name already exists.
If Len(strTestReportName) > 0 Then
varResponse = MsgBox("Following Report exists:-" _
& vbCrLf & strTestReportName & vbCrLf _
& "Do you want to overwrite it?", vbYesNo)

If varResponse = vbNo Then
wbSource.Close SaveChanges:=False
Exit Sub
End If
End If

'Save users existing Default # WorkSheets for new workbooks
intShtDefault = Application.SheetsInNewWorkbook

'Set default # WorkSheets ready for new workbook
Application.SheetsInNewWorkbook = 2

'Create new report workbook and assign to variable
'in single line of code.
Set wbReport = Workbooks.Add

'Reset the Users default # WorkSheets for new workbooks
Application.SheetsInNewWorkbook = intShtDefault

With wbReport
'Save the new report workbook.
Application.DisplayAlerts = False

'Saves reports in XL2007 format.
'Remove comment (single quote) to use this code
'and comment following XL97-2003 code.
'Also change strReportName above from .xls to .xlsx
'.SaveAs Filename:=strReportName, _
FileFormat:=xlOpenXMLWorkbook, _
CreateBackup:=False

'Saves reports in XL97-2003 format
'Comment out it using XL2007 code above.
.SaveAs Filename:=strReportName, _
FileFormat:=xlNormal, _
Password:="", _
WriteResPassword:="", _
ReadOnlyRecommended:=False, _
CreateBackup:=False

Application.DisplayAlerts = True

'Name the worksheets.
.Sheets(1).Name = "Location Update"

.Sheets(2).Name = "Technician Update"

'Assign worksheets to variables.
Set wsReport1 = .Sheets("Location Update")
Set wsReport2 = .Sheets("Technician Update")

'Copy the column headers from first Source
'Data worksheet to first worksheet in report.
With wsSource1
.Range(.Cells(1, 1), .Cells(.Columns.Count) _
.End(xlToLeft)).Copy _
Destination:=wsReport1.Cells(1, 1)
End With

'Copy the column headers from second Source
'Data worksheet to second worksheet in report.
With wsSource2
.Range(.Cells(1, 1), .Cells(.Columns.Count) _
.End(xlToLeft)).Copy _
Destination:=wsReport2.Cells(1, 1)
End With

End With

'Copies the Updated records to the report.

Call CopyUpdatesToReport(wsSource1, wsReport1)

Call CopyUpdatesToReport(wsSource2, wsReport2)

'*********************************************
'Need to find out what needs to be done with
'the source workbook after reporting completed
'and insert code here
'*********************************************

'Close workbooks and cleanup
wbSource.Close SaveChanges:=False
'Clear the assigned variable
Set wbSource = Nothing

wbReport.Save
wbReport.Close
Set wbReport = Nothing

ThisWorkbook.Activate
Sheets("Main Menu").Activate
Range("A1").Select

MsgBox "Report has been generated and saved as:" _
& vbCrLf & vbCrLf & strReportName


End Sub

Sub OpenWorkbook(myTitle As String, _
strInitSource As String)

Dim strFile As String
Dim strShortname As String
Dim fd As FileDialog

Set fd = Application.FileDialog(msoFileDialogFilePicker)

With fd
.InitialView = msoFileDialogViewDetails
.AllowMultiSelect = False
.InitialFileName = strInitSource
.Title = myTitle
If .Show = False Then
Exit Sub
End If
strFile = .SelectedItems(1)
End With

'Remove path and assign workbook name to string variable
strShortname = Right(strFile, Len(strFile) _
- InStrRev(strFile, "\"))

Set wbSource = Nothing
On Error Resume Next
Set wbSource = Workbooks(strShortname)
On Error GoTo 0

'If necessary turn off macro protection
'to open workbook
If wbSource Is Nothing Then
Application.AutomationSecurity _
= msoAutomationSecurityLow

Set wbSource = Workbooks.Open _
(strFile, UpdateLinks:=False, _
ReadOnly:=False)

'Turn macro protection back on.
Application.AutomationSecurity _
= msoAutomationSecurityByUI
End If
Set fd = Nothing
End Sub

Sub SetFlags(wsSource As Worksheet, _
wsMast As Worksheet)
Dim lastCol As Long
Dim flagCol As Long
Dim rngData As Range
Dim c As Range

'Sets flag for records updated.
With wsSource
'Find last column of data.
lastCol = .Cells(1, .Columns.Count) _
.End(xlToLeft).Column

'Set flag column as next column.
flagCol = lastCol + 1

'Clear any existing Update flags.
.Range(.Cells(1, flagCol), _
.Cells(.Rows.Count, flagCol).End(xlUp)) _
.Clear

Set rngData = .UsedRange 'Actual data range.

'Set the Update flags.
For Each c In rngData
If c.Value <> wsMast.Range(c.Address) Then

.Cells(c.Row, flagCol) = "Update"
End If
Next c
End With

End Sub

Sub CopyUpdatesToReport(wsSource As Worksheet, _
wsReport As Worksheet)

Dim lastCol As Long
Dim flagCol As Long
Dim c As Range

With wsSource
'Find last column header and save column number.
lastCol = .Cells(1, .Columns.Count) _
.End(xlToLeft).Column

'Assign next column number for Update Flag column
flagCol = lastCol + 1

For Each c In .Range(.Cells(2, flagCol), _
.Cells(.Rows.Count, flagCol).End(xlUp))

If c.Value = "Update" Then
.Range(.Cells(c.Row, 1), _
.Cells(c.Row, lastCol)).Copy _
wsReport.Cells(Rows.Count, "A") _
.End(xlUp).Offset(1, 0)
End If
Next c
End With


End Sub

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

 

[TraciAnn]

OssieMac,

Sorry for the delay. The TechAssignmentMaster.xlsx has been locking up. I
wanted to be sure I tested thoroughly and repeated your steps to copy code 3
times to a fresh file. Just to make sure before getting back to you.

Do you mind if we take a quick side note for one issue?

The project involving these sheets has now begun and at a minimum I need to:
1. Export current Technician information with the DB TechID's to the
respective TechAssignment?.xls file.
2. Create a column that will automatically create a unique ID (across
workbooks) for each Technician as they are added to the worksheet.
3. Create a Validation Lookup (?) on the Location sheet so when the agent
selects a technician name from the validated list it records the ID rather
than the name.

If I can get the above in place, I can continue to "clean-up" the data
manually before importing, buying more time to get the synchronization in
place.

I hope I'm not taking advantage of your benevolence. You have been so
helpful and I do not take that for granted. I didn't realize what I was
asking in my original post would require so much "hands-on".

If you would rather not invest the time....I understand.

Thankfully,
TraciAnn

 

[OssieMac]

Hi TraciAnn,

"If you would rather not invest the time....I understand". Somewhere in a
previous post I said something like I will see it through and I like to think
that I am a man of my word. I was well aware that it could become a marathon
issue and I love the challenge and it is simply a hobby for me these days.

What part of the world are you from. My pseudonym probable gives me away as
from Australia. Anyway at the moment it is 6:50am Saturday 2 May. I am going
to be out all day so cannot get on to it until late to day or maybe tomorrow.

I wonder how much confidential information is in your files. If you want to
create a Hotmail address that you can abandon later and post it here then I
will reply to it and perhaps we can share the files that way but I fully
understand if it will breach confidentiality.

Also in regards to my last post, what file format do you want to use for
each of the files? I understand that the TechAssignmentX.xls are all 97-2003
format but what about the the one with the code and the reports for the
extracted.

I don't really understand your questions 1 and 2. In 1 you say "Export
current Technician information with the DB TechID's " which indicates they
already have an Id and in 2 you say "Create a column that will automatically
create a unique ID".

 

[OssieMac]

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 worksheet:-
In cell A1 enter Id
In cell B1 enter First Name
In cell C1 enter Last Name

Right click the worksheet 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
worksheet. 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

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

 

[TraciAnn]

OssieMac,

I'm not ignoring you, I'm swamped!!!!

I knew this would happen. xhe first wave of agent spreadsheets have beex
coming back to me a couple times a day. Since I xust wasn't able to figure
everythixg out in time, I am now going thrxugh thousands of records a day
trying to straighten out the spreadsxeet before importing into the db.

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.

You are correct in assuming the confidentiality, the records contain
personal information so I need to be sure everything is stripped and/or
"sample" data.

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.

Will do! Thank you so much!!!!

Per your suggestion, randomly generated email address...in second paragraph
replace "x"s with correct letter and send to yahoo.

I may be a little slow in my responses due to how overwhelming the task is
right now. It won't slow down for two weeks and then we catch our breath to
do it all over again in a month.

Thanks OssieMac!!!

TraciAnn