PDA

View Full Version : Consolidate data to one master workbook



georgedaws
09-10-2010, 03:04 PM
Good evening to all!

Before I start I have searched for the last five hours trynig to get the solution to my problem. I have my desktop full of example spreadsheets but none seem to fit what I need.

I hope someone can help with this. Please excuse the way put my problem across if it gets a bit garbled.

So, I have an application tracker which nine other departments will have a copy of and they will all use independantly. These workbooks are all identical in colums,headers etc. All that would be different is the names of the applicants, dates and the like. The name of that sheet is "DATABASE"

These would be stored in the same drive, one main folder, but then split into nine departmental folders.

For reporting purposes I would like to extract the data from one particular sheet from those nine workbooks, (the applicant info) and combine it into the "master DATABASE" sheet.

In addition on the master application tracker, nine other sheets could be placed on representing the other departments. At the same time this information is called to consolidate those additional sheets could be updated.

If I could run with a command button to call a macro so it doesn't duplicate the data and can refresh that would be great.

I thought maybe a timed auto refresh could be an idea but I imagine that is quite involved.

The bigger picture is to be able to analyse the data individually by department as well as consolidated.

Again, I have really tried with all the examples I have downloaded and I cannot see the wood for the trees with this.

Well if anyone can help with this one, I would very much appreciate it.


Thanks,


Stewart

GTO
09-10-2010, 05:22 PM
Greetings Stewart,


So, I have an application tracker which nine other departments will have a copy of and they will all use independantly. These workbooks are all identical in colums,headers etc. All that would be different is the names of the applicants, dates and the like. The name of that sheet is "DATABASE"

These would be stored in the same drive, one main folder, but then split into nine departmental folders.

For reporting purposes I would like to extract the data from one particular sheet from those nine workbooks, (the applicant info) and combine it into the "master DATABASE" sheet.

This seems to make sense, but for clarity's sakes:

Are the subfolders all located in the 'main' folder?
In the nine subfolders, are we going to find only one workbook in ea subfolder, or do we need to worry about the workbook's name?
In addition on the master application tracker, nine other sheets could be placed on representing the other departments. At the same time this information is called to consolidate those additional sheets could be updated.

Ya lost me.

Might I suggest:

Create two temp folders.
In folder 1:
Create two 'child' workbooks w/some fake data.
Create a 'master' wb with how it should look after.
In folder 2:

Show what the child wb's should look lke updated.
SAA for the master.
Put both folders into a zip and post.

I think that we could more easily see what is being wanted, and this saves any 'answerer' the guessing while he/she trys to recreate the child wb's.

Hope that helps,

Mark

georgedaws
09-11-2010, 03:13 AM
Hi GTO,

Thank for getting back to me. Second part did sound a bit messed up I agree.
It was getting late and i was getting a bit cross eyed!

I have attached before and afters as you suggested. I hope I have set them up OK.

With regards to their storage.

All the workbooks will be stored in subfolders held in one main folder for example main folder titled "department" and sub folders "department 1", "department 2" etc.

The main head honcho work book will be in a separate folder but still on the main network drive.

You will notice that the"manager" still has a database of their own to process queries. When the data is fetched their datbase is also incorporated into the "master database" this is for total accountability for when the data is analysed.

I should mention that I am a complete new boy at all of this, but I do love it!

Hope to hear from you, or anyone else.

Ta,

Stewart

GTO
09-11-2010, 05:00 AM
ACK!

Sorry about that. I meant two regular Folders (w/wb's) in the zip. A cannot read .rar.

I also should have mentioned that if you are using 2007+ Excel, create the wb's in .xls format, as there are still those of us who do not.

Mark

georgedaws
09-11-2010, 05:06 AM
Hi GTO.

All done in .zip and and they are in .xls format.

Thanks,

Stewart

GTO
09-11-2010, 04:08 PM
Hi Stewart,

I have no illusions that this will immedietely be a stellar solution, but here are my initial observations as to potential problems, and a first try to get us on the way to a solution.

Also, I would certainly invite comments, corrections, or observations from others, as this is certainly on-the-fly.

I think our first issue is that you (or whoever runs the Master) is working similar hours as those who are filling in the 'child' workbooks. I am at home, so cannot test against another user having a wb open, so we'll skip that for now and make a huge assumption that the child wb's are all closed.

Next, before we open the child wb's and extract data, we need to find them. With nine known subfolders, this should be easy - but users have a habit of being "helpful". In this case, adding a subfolder to the main Department folder, or tacking another wb into any of the subfolders are the first things that come to mind. IMO, this is handle-able if we can count on naming conventions.

So... I named the main folder 'Department' and the subfolders 'Department 1', 'Department 2'. I think/hope I took into account other departments might be added, in case we need to start looking for two-digit dept. numbers.

The child wb's are named: 'Department 1 Use.xls', Department 2 Use.xls'

NOTE: I am using all the "Before" files.

In wb Master, I named the 'child' sheets, 'DEPARTMENT 1 DATABASE' and 'DEPARTMENT 2 DATABASE'. Please note the spaces.

In wb Master, I added the first record from 'Department 1 Use.xls' (Note the rename/space in the wb's name); the record with 'A/1/1' as a log number.

----------------------------------------
A/1/1 Mr smith 2 Acheson (unable to put date) where is x etc

----------------------------------------

In wb 'Department 1 Use.xls', I added a record:

----------------------------------------
A/1/1 Mr smith 2 Acheson 9/11/2010 where is x etc
A/1/2 Mr Thompson 3 jones (unable...) payments etc
----------------------------------------

Okay,to recap: We are counting ever-so-hopefully on consistent folder/file/sheet naming conventions.

I am also going to take a leap of faith and count on new records being added to the bottom of the child sheets. Thus - we will just look at last record's log 'number' in the appropriate sheet in Master, and copy anything below that in the respective child wb.


Option Explicit

Sub Main()
Dim FSO As Object '<--- FileSystemObject
Dim fsoFolder As Object '<--- Folder
Dim REX As Object '<--- RegExp
Dim WB As Workbook
Dim wksSource As Worksheet
Dim wksDest As Worksheet
Dim rngLastCurLog As Range
Dim rngLastNewLog As Range
Dim lMatchDest As Long
Dim lMatchSource As Long
Dim strFolOrFilName As String
Dim strLastCurLog As String
Dim bolOldRecordExists As Boolean
Dim bolNewRecordExists As Boolean
Dim arySourceVal As Variant

'// Change Main folder path to suit //
Const MAIN_FOL_PATH As String = "D:\2010\_Tmp\2010-09-10\vbax33978\Department\"

Set FSO = CreateObject("Scripting.FileSystemObject")
Set REX = CreateObject("VBScript.RegExp")

If Not FSO.FolderExists(MAIN_FOL_PATH) Then
MsgBox "Contact Administrator..."
Exit Sub
End If

Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

For Each fsoFolder In FSO.GetFolder(MAIN_FOL_PATH).SubFolders

strFolOrFilName = fsoFolder.Name

'// Rudimentary but maybe (not sure) useful later if aberrant spacing. Returns //
'// TRUE if folder named like "Department " and 1 to many digits. Also returns //
'// filname we should expect therein. //
If MatchReturn(REX, strFolOrFilName, " Use.xls", "^Department\ [0-9]+$") Then

If FSO.FileExists(fsoFolder & "\" & strFolOrFilName) Then

Set WB = Workbooks.Open(fsoFolder & "\" & strFolOrFilName, , True)

If ShExists("DATABASE", WB) Then

Set wksSource = WB.Worksheets("DATABASE")
'// NOT tested, but if there is a new department and no sheet for it//
'// in ThisWorkbook, I was thinking just copy the source sheet. //
If Not ShExists(fsoFolder.Name & " DATABASE") Then
wksSource.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
WB.Close False
Else
'// Else set a reference to the correct sheet in ThisWorkbook. //
Set wksDest = ThisWorkbook.Worksheets(fsoFolder.Name & " DATABASE")

With wksDest
'// Set a reference to the cell with last log no. in //
'// ThisWorkbook. //
Set rngLastCurLog = _
RangeFound(.Range(.Cells(2, 1), .Cells(.Rows.Count, 1)))
'// If Is Nothing, there have been no records imported for //
'// this particular deparment. We'll need to handle, as //
'// if there is a last record, we use it to figure where the//
'// new records start in the source wb. //

If Not rngLastCurLog Is Nothing Then
bolOldRecordExists = True
strLastCurLog = rngLastCurLog.Value
lMatchDest = rngLastCurLog.Row + 1
Else
bolOldRecordExists = False
strLastCurLog = vbNullString
lMatchDest = 2
End If
End With

With wksSource

Set rngLastNewLog = _
RangeFound(.Range(.Cells(2, 1), .Cells(.Rows.Count, 1)))

If Not rngLastNewLog Is Nothing Then
bolNewRecordExists = True
If strLastCurLog = vbNullString Then
lMatchSource = 2
Else
'// NOT tested, but in case the source wb has been //
'// cleared of old records and only new records //
'// exist, MATCH would fail. //
On Error Resume Next
lMatchSource = _
Application.Max( _
Application.Match(strLastCurLog, _
.Range(.Cells(2, 1), rngLastNewLog), _
0) + 2, _
2)
On Error GoTo 0
End If
arySourceVal = .Range(.Cells(lMatchSource, 1), _
.Cells(Application.Max( _
RangeFound(.Range(.Cells(2, 1), _
.Cells(.Rows.Count, 1))).Row, _
lMatchSource), 12)).Value
Else
'// NOT tested//
' Nothing to copy
strLastCurLog = vbNullString
lMatchDest = 0
lMatchSource = 0
WB.Close False
GoTo NextLoop
End If
End With

With wksDest
.Range(.Cells(lMatchDest, 1), _
.Cells(lMatchDest + UBound(arySourceVal, 1) - 1, "L") _
).Value = arySourceVal
End With
WB.Close False
End If
Else
WB.Close False
Set WB = Nothing
End If
End If
End If
NextLoop:
Next
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Function MatchReturn(REX As Object, _
NameString As String, _
TackOn As String, _
REXPattern As String, _
Optional REXGlobal As Boolean = False, _
Optional REXIgnoreCase As Boolean = True _
) As Boolean
With REX
.Global = REXGlobal
.IgnoreCase = REXIgnoreCase
.pattern = REXPattern
MatchReturn = .Test(NameString)
End With

If Not MatchReturn Then
NameString = vbNullString
Exit Function
Else
NameString = NameString & TackOn
End If
End Function

Function ShExists(ShName As String, _
Optional WB As Workbook, _
Optional CheckCase As Boolean = False) As Boolean

If WB Is Nothing Then
Set WB = ThisWorkbook
End If

If CheckCase Then
On Error Resume Next
ShExists = CBool(WB.Worksheets(ShName).Name = ShName)
On Error GoTo 0
Else
On Error Resume Next
ShExists = CBool(UCase(WB.Worksheets(ShName).Name) = UCase(ShName))
On Error GoTo 0
End If
End Function

Function RangeFound(SearchRange As Range, _
Optional FindWhat As String = "*", _
Optional StartingAfter As Range, _
Optional LookAtTextOrFormula As XlFindLookIn = xlValues, _
Optional LookAtWholeOrPart As XlLookAt = xlPart, _
Optional SearchRowCol As XlSearchOrder = xlByRows, _
Optional SearchUpDn As XlSearchDirection = xlPrevious, _
Optional bMatchCase As Boolean = False) As Range

If StartingAfter Is Nothing Then
Set StartingAfter = SearchRange(1)
End If

Set RangeFound = SearchRange.Find(What:=FindWhat, _
After:=StartingAfter, _
LookIn:=LookAtTextOrFormula, _
LookAt:=LookAtWholeOrPart, _
SearchOrder:=SearchRowCol, _
SearchDirection:=SearchUpDn, _
MatchCase:=bMatchCase)
End Function

It got a bit schmucky but see if that's a decent start.

Hope that helps,

Mark

georgedaws
09-12-2010, 02:40 AM
Hi GTO,

Thank you for help. Honestly I really appreciate it. I am sanding down my lounge ceiling at the moment (deep joy!) so I will have a look at that tonight and let you know how it's gone. Crikey though, that's a lot of code! I would'nt know where to start if I had to do that!

I have just been spoken to like a child on another post so it's kinda put me off asking questions.

Still Yourself and Ken paul have been great to me on this forum. You are indeed a credit to it.

Let you know!

Stewart

georgedaws
09-12-2010, 01:00 PM
Hi GTO, Just managed to have a look at the code and I have set the folder directory up properly and renamed the child wb's

Just to clarify, do I paste this code into the master workbook itself or master consolidated database worksheet?

I take it i would then set up a command button and assign the macro so it would update?

For testing I am just going to have all three workbooks in a folder, update the department ones then try and fetch with the master.

Thanks GTO,


Stewart

GTO
09-12-2010, 02:14 PM
Thank you for help. Honestly I really appreciate it. I am sanding down my lounge ceiling at the moment (deep joy!) so I will have a look at that tonight and let you know how it's gone. Crikey though, that's a lot of code! I would'nt know where to start if I had to do that!

Overhead sanding: the joy of burning shoulders and stuff in eyes/nose/throat. What's not to like?:hide:


I have just been spoken to like a child on another post so it's kinda put me off asking questions.

Maybe you mean another thread at another site, but if its the other one here, I respectfully disagree and for what its worth, can assure you that you mis-perceived.


Just to clarify, do I paste this code into the master workbook itself or master consolidated database worksheet?

Sorry - I should have specified. The code goes in a Standard Module, not in any worksheet's module.


I take it i would then set up a command button and assign the macro so it would update?

You could use a command button, either ActiveX or from the Forms toolbar, or add a command to the menubar or a shortcutkey combo; whatever you like.


For testing I am just going to have all three workbooks in a folder, update the department ones then try and fetch with the master.

You will need to modify the code then, as it looks for a workbook name based upon the folder that it resides in.

Here is updated code. It works primarily the same way, but you will see that I used .Find instead of blowing by errors and using .MATCH and .MAX in determining where stuff should be coming from/going to. I commented this much more thoroughly, hope it helps in learning all that is "going on" in the code.


Option Explicit

Sub Main()
Dim FSO As FileSystemObject ' Object '<--- FileSystemObject
Dim fsoFolder As Folder ' Object '<--- Folder
Dim REX As RegExp ' Object '<--- RegExp
Dim WB As Workbook
Dim wksSource As Worksheet
Dim wksDest As Worksheet
Dim rngLastDestLog As Range
Dim rngLastNewLog As Range
Dim rngToCopy As Range
Dim rngFoundOld As Range
Dim lMatchDest As Long
Dim lMatchSource As Long
Dim strFolOrFilName As String
Dim strLastDestLog As String
Dim bolLookForExists As Boolean
Dim bolNewRecordsExist As Boolean
Dim arySourceVal As Variant

'// Change Main folder path to suit //
Const MAIN_FOL_PATH As String = "D:\2010\_Tmp\2010-09-10\vbax33978\Department\"

'// Set references to FSO and RegExp //
Set FSO = CreateObject("Scripting.FileSystemObject")
Set REX = CreateObject("VBScript.RegExp")

'// If we do not find the main folder in the prescribed path, bail now! //
If Not FSO.FolderExists(MAIN_FOL_PATH) Then
MsgBox "Contact Administrator..."
Exit Sub
End If

'// Disable events so that we don't get the msgbox's and such when we are planting //
'// vals in various cells. //
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'// For each subfolder in our main folder... //
For Each fsoFolder In FSO.GetFolder(MAIN_FOL_PATH).SubFolders

'// Get the folder's name... //
strFolOrFilName = fsoFolder.Name

'// ...and send it to MatchReturn to see if it is a valid named folder. If //
'// TRUE, return the name (via strFolOrFilName) of the file/wb we should find //
'// therein. //
If MatchReturn(REX, strFolOrFilName, " Use.xls", "^Department\ [0-9]+$") Then

'// If the file we are wanting to find exists... //
If FSO.FileExists(fsoFolder.Path & "\" & strFolOrFilName) Then

'// ...open it and ... //
Set WB = Workbooks.Open(fsoFolder.Path & "\" & strFolOrFilName, , True)

'// ...see if the sheet we want exists. If not, close the wb under the //
'// Else. You may want to add a msgbox under the Else, "sheet not found//
'// in WB.name" or something, so that you know it got skipped. //
If ShExists("DATABASE", WB) Then

'// If we found the worksheet in the child/source wb, set a reference//
Set wksSource = WB.Worksheets("DATABASE")

'// If there is a new department and no sheet for it, in //
'// ThisWorkbook, I was thinking just copy the source sheet and //
'// rename it. //
If Not ShExists(fsoFolder.Name & " DATABASE") Then
wksSource.Copy _
After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)

Set wksDest = ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
wksDest.Name = _
UCase(Left(strFolOrFilName, _
InStrRev(strFolOrFilName, " Use.xls") - 1) & _
" DATABASE")
WB.Close False
Else
'// Else set a reference to the correct sheet in ThisWorkbook. //
Set wksDest = ThisWorkbook.Worksheets(fsoFolder.Name & " DATABASE")

'// You can 'un-REM' this while stepping thru (F8) to see what's//
'// going on. Delete when done. //
'Debug.Print wksDest.Name: wksDest.Parent.Activate: wksDest.Select

With wksDest
'// Set a reference to the last cell in Col A that has a //
'// val (log#). Note: our search range is from A2 to the //
'// bottom of the sheet. We search (read thru the Function)//
'// from "after" the first cell and we are searching //
'// xlPrevious (upwards), so we are actually searching from //
'// the bottommost cell. //
Set rngLastDestLog = _
RangeFound(.Range(.Cells(2, 1), .Cells(.Rows.Count, 1)))

'// If we find a cell with a log#, rngLastDestLog will NOT //
'// be NOTHING, that is, it will be something (a Range //
'// Object), so we pass the test. //
If Not rngLastDestLog Is Nothing Then
'// so we have a log# to look for... //
bolLookForExists = True
'// and we'll grab its value //
strLastDestLog = rngLastDestLog.Value
lMatchDest = rngLastDestLog.Row + 1
Else
bolLookForExists = False
strLastDestLog = vbNullString
lMatchDest = 2
End If
End With

'// Now with our child/source wb... //
With wksSource

'// Find the last last log# as before. //
Set rngLastNewLog = _
RangeFound(.Range(.Cells(2, 1), .Cells(.Rows.Count, 1)))

'// In case the source sheet has log#(s), but hasn't had any//
'// new ones added since we last ran our code, we need an //
'// additional test. If either rngLastNewLog IS NOTHING //
'// (ie - the sheet is there, but there's no records yet), //
'// or if the last log# is equal to the last log# in our //
'// destination wb (ThisWorkbook), we know there's no //
'// records to copy. //
If Not rngLastNewLog Is Nothing Then
bolNewRecordsExist = _
Not rngLastNewLog.Value = strLastDestLog
Else
bolNewRecordsExist = False
End If

'// If we have new records to copy... //
If bolNewRecordsExist Then

'// if there were no log#s in the destination sheet, we //
'// need to copy all records in the source sheet. //
If Not bolLookForExists Then
Set rngToCopy = _
.Range(.Range("A2"), rngLastNewLog.Offset(, 11))
Else
'// Else we will attempt to find the last log# from //
'// the destination sheet. Note that as we are not //
'// just looking for the last row, we include //
'// the FindWhat arg. //
Set rngFoundOld = _
RangeFound(.Range(.Cells(2, 1), _
.Cells(.Rows.Count, 1)), _
strLastDestLog, , , xlWhole)

'// If amongst the records in the source sheet, we //
'// find the correct log#, we set the range from //
'// one row below it, to the last current record in //
'// the source sheet. //
If Not rngFoundOld Is Nothing Then
Set rngToCopy = _
.Range(rngFoundOld.Offset(1), _
rngLastNewLog.Offset(, 11))
Else
'// Else we need all the records from source sht//
Set rngToCopy = _
.Range(.Range("A2"), rngLastNewLog.Offset(, 11))
End If
'SAA
'Debug.Print rngToCopy.Parent.Parent.Name & " Sheet: " & _
rngToCopy.Parent.Name & " " & _
rngToCopy.Address
End If

'// Plunk the vals from our determined range into an //
'// array. //
arySourceVal = rngToCopy.Value
Else
'// Nothing to copy //
strLastDestLog = vbNullString
lMatchDest = 0
lMatchSource = 0
WB.Close False
GoTo NextLoop
End If
End With

'// Back to our destination sheet. //
With wksDest
'// I had issues, probably related to resetting the module //
'// while coding. Anyways, just seems cheap insurance. //
.Protect Password:="MyPassword", UserInterfaceOnly:=True
'// Size our destination array, from the row below the last //
'// log#, to that row + the ubound of the first dimension of//
'// our array (which will equal how many rows we plunked into//
'// our array) - 1, from column 1 to column 12/"L". //
'// Plunk the array into the equally sized range. //
.Range(.Cells(lMatchDest, 1), _
.Cells(lMatchDest + UBound(arySourceVal, 1) - 1, "L") _
).Value = arySourceVal
End With
WB.Close False
End If
Else
WB.Close False
Set WB = Nothing
End If
End If
End If
NextLoop:
Next
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Please note that the functions:
MatchReturn
ShExists
RangeFound

...remain required. There were no changes in these, so no repost.

Hope that helps,

Mark

georgedaws
09-13-2010, 01:01 AM
Hi GTO,

I have one more skim to put on the ceiling then I can sit down at the spreadsheet and have a good play, as it were!

You are probably right, maybe I did mis percieve, but I am never too proud to admit otherwise. Sometimes we can mis percieve tone in written words a lot easier than if we heard them spoken.

To your other points; right, now I know which module to put the code in and I will assign it to a command button (happy days) and I will look at the folder location.

I will post back later, (when I get off that ceiling!) and let you know.

Thanks Mark,


Stewart

georgedaws
09-13-2010, 12:36 PM
Hi Mark,

Well!

The first script you posted fetched the child worksheets fine, but the "master consolidated database did not collate the info from the two deaprtments and the master "database" worksheet. (I hope that makes sense)

With your second updated code I recieved a compile error on
Dim FSO As FileSystemObject ' Object '<--- FileSystemObject

This was fine, as I went to tools/references and ticked "microsoft scripting runtime"

I re-ran the code (via command button) and another compile error alluding to
Dim REX As RegExp ' Object '<--- RegExp

Now, looking at your previous code, (just proving that I am trying to learn mate!) I noticed you had named that code
Dim REX As Object '<--- RegExp so I changed it to that and re-run.

I am now stuck at another compile error "sub or function not defined" with just the word "MatchReturn" highlighted in blue.

So at the moment I cannot go any further with it as I cannot find any other referenced to the word or how to solve it myself.

I have posted the most up-to -date version with all the name changes you have suggested and the present code.

Could you see what the compile error is, and I cannot tell by your code help text if these department database sheets are also going to collate onto the "master consolodated database".

Sorry to be a drain Mark, I am tryimg to help myself!


Thanks,

Stewart

georgedaws
09-13-2010, 01:02 PM
Hi Mark,

I cannot upload the file. Keep getting timeout. I will carry on trying.

Stewart

GTO
09-13-2010, 01:36 PM
Well!

My sentiments exactly! You will have to excuse me (or at least hopefully), as I'm not sleepy quite yet, but very 'faded'. Night shift this time around seems a steeper hill (which is sooo much 'politer' than I would express it an adult only crowd).


The first script you posted fetched the child worksheets fine, but the "master consolidated database did not collate the info from the two deaprtments and the master "database" worksheet. (I hope that makes sense)

It makes some sense, but in my opinion, a ways off. I do not know 'your people', but in my experience, folks turning in data may not consider it as 'sexy' or important as the one trying to collect all the data. Shocking, eh? Whilst it would seem easy to say "purge the scoundrels", most likely, they so most of the job great. Thus - and again, just IMO, its imprtant to figure out how to prevent others from goobering up the outcome.

Anyways, lets make sure the initial bit seems at least 'fire retardant' before moving on, it you don't mind.


With your second updated code I recieved a compile error on
Dim FSO As FileSystemObject ' Object '<--- FileSystemObject

ACK! I oft write in early-binding, the change to late-binding before giving to others. I missed the last step (changing to late-binding). You will want to read in vba help, but in short, early-binding requires setting references to the appropriate libraries during design time, via VBIDE's menubar > Tools|References as you mention below.


This was fine, as I went to tools/references and ticked "microsoft scripting runtime"

Early-binding can provide faster running code. There is a time or two (such as Dictionary Keys) where early-binding avoids workarounds. That said, late-binding avoids issues such as running the code in an earlier version after running in a later version.


I re-ran the code (via command button) and another compile error alluding to
Dim REX As RegExp ' Object '<--- RegExp

Now, looking at your previous code, (just proving that I am trying to learn mate!) I noticed you had named that code
Dim REX As Object '<--- RegExp so I changed it to that and re-run.

Nicely done.:thumb


I am now stuck at another compile error "sub or function not defined" with just the word "MatchReturn" highlighted in blue.

So at the moment I cannot go any further with it as I cannot find any other referenced to the word or how to solve it myself.

Re-read the tail end of post 9. I did mention that the supplementary functions were still req'd. AS the had not changed from post 6, I did not re-post them.


..and I cannot tell by your code help text if these department database sheets are also going to collate onto the "master consolodated database"...

Sorry to be a drain Mark, I am tryimg to help myself!

Nope, not yet.

No problems, keep tearing apart the code, stepping thru it, useing the locals window and vba help - it wil make sense.

Have a great day,

Mark

georgedaws
09-13-2010, 01:58 PM
Mark,

I've read what you wrote, about ten times and 60% of it went in LOL!

Sorry about not reading tail end of post nine.

Right! I am getting the hang of this now, (green writing helps!)

Will get back to you once successful for part two: (cue music) "The master consolidated database".

And I know what you mean with Night Shifts! I get subjected to a few myself!

I owe you a pint mate!

Cheers,


Stewart

georgedaws
10-03-2010, 01:03 AM
Hi again,

I have finally managed to make all the sheets to consolidate onto the master worksheet which I am happy about.

My last problem is the sub folder and workbook names.

At present the code to find subfolders and workbooks is as follows;If MatchReturn(REX, strFolOrFilName, " Use.xls", "^Department\ [0-9]+$") Then



I have tried modifying the code without success. I need the search to include any named sub folder and within that sub folder any named workbook. As long as the "database" sheet is pulled from each workbook.

I am thinking that the "matchreturn" function may be the problem as it is too specific but it is only my guess.

GTO did a blinding job on the code for me and the code I have posted refers to post 9, just in case someone needs to see the big picture.

Mark, if you are reading this and you can help me with this last bit, I would be very grateful mate; if anyone else can help, thank you in advance.

Thanks for reading,


Stewart

deyken
10-04-2010, 08:03 AM
Hi All,

Please forgive if I seem to interject rudely here, but I think I might have a better suggestion: Why not reference all the WorkBooks as Database Tables? Then you could use simple SQL to extract the information into virtual recordsets, and run a final algorythm to consolidate. MUCH less code and much more accurate. We could use MS Jet 4.0 for the Connection Object and ADO for the RecordSet Objects.

Also, since you guys have already nailed down the const file paths and a standard naming convention for all WBs, programmer does not need to worry about file names either, thus referencing the (Now) "Database Tables" is as easy as pie.

If you agree, let me take a shot at it...

georgedaws
10-04-2010, 02:42 PM
Hi deyken,

I am totally lost with what you wrote because of my inexperiance. It went "woosh" right over my head LOL!

By all means have a look at it and see what you can do.

Thanks for looking, and I am looking for to what it is you are going to do!

Thanks,

Stewart

deyken
10-04-2010, 10:34 PM
Hi George,

I downloaded copies of all the files you uploaded and I am working on a robust and dynamic adaptable solution for you. I have been programming Databases and front-ends for the latter for many years now, so my initial response to situations like yours will always be DB, DB, DB :)

So, in order for me to devise the absolute correct solution, I need some basic guidance from you. Below I list the protocol/algorythm that you want your users to follow to complete the information in their respective sheets:

1. User opens a network shared copy for his/her department from the Network drive: like: admin?
2. He completes his entry, all the while being able to search for previously entered data etc etc?
3. He saves the workbook again, back to the network drive
4. Subsequent users can then also access this file (in the same department) and add their data etc etc etc?

What you then need to do is (at a later and/or pre-determined stage) take your Master file and click a button that will now go to each individual department folder, open (behind the scenes) the "admin" (and other such) Excel files, read its data (new and old) and collect the new data and enter that into your Master file.

Do I have the algorythm correct here? Please spare no details, as even the smallest details can sometimes change the entire programming process. This, however, is actually quite easy to program, so long as I know exactly what you want this program to accomplish everyday.

Let me know...

georgedaws
10-05-2010, 05:25 AM
Hi deyken,

You have described everything exactly that I want the databases to achieve every day.

My final plan for the master file would be to take the collated data and try and make a dashboard. I am looking at info captor to do this. I think this would be the right way to go with reporting and presenting the data.

I cannot think of any other minor details to include, but as you can see, i have various protections within the spreadsheets so user cannot tamper with dates and such.

I cannot wait to see what you do it and learn from it!

Thank you for giving a fresh perspective to it deyken!

Thanks,


Stewart

deyken
10-05-2010, 06:57 AM
Hi Stewart,

OK, here we go. Below I indicate the main function that perfoms the entire algorythm in one go. I typed out most of the logic so that you can see exactly what I did and how/why I did it. My time ran a bit short today, so I had little chance to test the code. Please test it on your side and let me know?

NOTE: Change the File paths to your own for the various applicable variables.

Option Explicit
Sub ImportData()
' This is the MAIN function that will collect the data from the different department file locations
' and append that data to the end of this main file = MAIN CONSOLIDATED DATABASE.xls


'******** FILE NAME VARIABLE BLOCK ********************
Dim fileMASTER As String
Dim fileADMIN As String ' File path for admin department
Dim fileFINANCE As String
Dim fileOTHER As String
Dim fileSTORES As String
Dim fileTECH As String ' Technical department - the original file was named finance.xls against, so i renamed it...

' Assign file paths - For this exercise I am using variables, but you can use constants later on
fileADMIN = "C:\Documents and Settings\hendrikp\My Documents\Text Files\Excel Netweork Sharing Files\Department\admin\admin.xls" ' I hard code it here, but suggest you dynamically assign file path using a FileExists() function or similar"
fileFINANCE = "C:\Documents and Settings\hendrikp\My Documents\Text Files\Excel Netweork Sharing Files\Department\finance\finance.xls"
fileOTHER = "C:\Documents and Settings\hendrikp\My Documents\Text Files\Excel Netweork Sharing Files\Department\other\other.xls"
fileSTORES = "C:\Documents and Settings\hendrikp\My Documents\Text Files\Excel Netweork Sharing Files\Department\stores\stores.xls"
fileTECH = "C:\Documents and Settings\hendrikp\My Documents\Text Files\Excel Netweork Sharing Files\Department\technical\technical.xls"
fileMASTER = "C:\Documents and Settings\hendrikp\My Documents\Text Files\Excel Netweork Sharing Files\Department\master consolidated\CONSOLIDATE ONLY1.xls"
' ********** END OF FILENAME VARIABLE BLOCK ************

'*********************************
' ADO DATABASE OBJECTS DECLARATION
'*********************************
Dim cnAdmin As New ADODB.Connection
Dim cnFinance As New ADODB.Connection
Dim cnOther As New ADODB.Connection
Dim cnStores As New ADODB.Connection
Dim cnTech As New ADODB.Connection
Dim cnMASTER As New ADODB.Connection

Dim Admin As New ADODB.Recordset
Dim Finance As New ADODB.Recordset
Dim Other As New ADODB.Recordset
Dim Stores As New ADODB.Recordset
Dim Tech As New ADODB.Recordset
Dim MASTER As New ADODB.Recordset
' **** END ADO OBJECTS DECLARATION ************

' XXXXXXXXXXXXXXXXXX CORE ACTIONS XXXXXXXXXXXXXXXXXXXXXXXXXXXX

' 1. Open "Database" connections
cnAdmin.Open "Driver={Microsoft Excel Driver (*.xls)};DriverId=790;Dbq=" & fileADMIN & ";DefaultDir=" & fileADMIN & ";"
cnFinance.Open "Driver={Microsoft Excel Driver (*.xls)};DriverId=790;Dbq=" & fileFINANCE & ";DefaultDir=" & fileFINANCE & ";"
cnOther.Open "Driver={Microsoft Excel Driver (*.xls)};DriverId=790;Dbq=" & fileOTHER & ";DefaultDir=" & fileOTHER & ";"
cnStores.Open "Driver={Microsoft Excel Driver (*.xls)};DriverId=790;Dbq=" & fileSTORES & ";DefaultDir=" & fileSTORES & ";"
cnTech.Open "Driver={Microsoft Excel Driver (*.xls)};DriverId=790;Dbq=" & fileTECH & ";DefaultDir=" & fileTECH & ";"
cnMASTER.Open "Driver={Microsoft Excel Driver (*.xls)};DriverId=790;Dbq=" & fileMASTER & ";DefaultDir=" & fileMASTER & ";"

' 2. Open RecordSets
Admin.Open "SELECT * FROM [Sheet2$]", cnAdmin, adOpenDynamic, adLockOptimistic
Admin.MoveFirst
Finance.Open "SELECT * FROM [Sheet2$]", cnFinance, adOpenDynamic, adLockOptimistic
Finance.MoveFirst
Other.Open "SELECT * FROM [Sheet2$]", cnOther, adOpenDynamic, adLockOptimistic
Other.MoveFirst
Stores.Open "SELECT * FROM [Sheet2$]", cnStores, adOpenDynamic, adLockOptimistic
Stores.MoveFirst
Tech.Open "SELECT * FROM [Sheet2$]", cnTech, adOpenDynamic, adLockOptimistic
Tech.MoveFirst
MASTER.Open "Select * FROM [Sheet2$]", cnMASTER, adOpenDynamic, adLockOptimistic

' 3. Perform Data Transfer
While Not Admin.EOF
MASTER.AddNew
MASTER.Fields(0).Value = Admin.Fields(0).Value
MASTER.Fields(1).Value = Admin.Fields(1).Value
MASTER.Fields(2).Value = Admin.Fields(2).Value
MASTER.Fields(3).Value = Admin.Fields(3).Value
MASTER.Fields(4).Value = Admin.Fields(4).Value
MASTER.Fields(5).Value = Admin.Fields(5).Value
MASTER.Fields(6).Value = Admin.Fields(6).Value
MASTER.Fields(7).Value = Admin.Fields(7).Value
MASTER.Fields(8).Value = Admin.Fields(8).Value
MASTER.Fields(9).Value = Admin.Fields(9).Value
MASTER.Fields(10).Value = Admin.Fields(10).Value
MASTER.Fields(11).Value = Admin.Fields(11).Value
MASTER.Fields(12).Value = Admin.Fields(12).Value
MASTER.Update
Admin.MoveNext
Wend ' Now repeat this loop for each individual "Table" or Excel File: Finance, Other etc.

' This (rather extensive) example covers the collection of data from each "table" and appends each such set to the MASTER CONSOLIDATED "table"
' All accomplished with the click of a single button!
' I purposely did not include the On Error Resume Next function, since this may skip important data. If you do encounter
' an error during any of the loops, click the "Debug" option and let me know what line it busts out on. Most of the times
' an error happens due to incompatible data types or the like.
End Sub

Look forward to your feedback!

georgedaws
10-05-2010, 07:05 AM
Hi Deyken,

That was quick! I wish I had the knowledge!

I will give it a test in a couple of hours as i will be besieged by my children returning from school any moment!

I will let you know how I get on.

Brilliant! Big Thanks!

Stewart

georgedaws
10-05-2010, 07:47 AM
Hi Deyken,

I have had a quick look and i hope you don't mind me asking a couple of questions

Firstly;

I hard code it here, but suggest you dynamically assign file path using a FileExists() function or similar"
I am not sure how to dynamically assign the file paths, could you tell me how please.


Now repeat this loop for each individual "Table" or Excel File: Finance, Other etc.
I take it after
Wend I would repeat the preivious code as such
While Not Admin.EOF
MASTER.AddNew
MASTER.Fields(0).Value = Admin.Fields(0).Value
MASTER.Fields(1).Value = Admin.Fields(1).Value
MASTER.Fields(2).Value = Admin.Fields(2).Value
MASTER.Fields(3).Value = Admin.Fields(3).Value
MASTER.Fields(4).Value = Admin.Fields(4).Value
MASTER.Fields(5).Value = Admin.Fields(5).Value
MASTER.Fields(6).Value = Admin.Fields(6).Value
MASTER.Fields(7).Value = Admin.Fields(7).Value
MASTER.Fields(8).Value = Admin.Fields(8).Value
MASTER.Fields(9).Value = Admin.Fields(9).Value
MASTER.Fields(10).Value = Admin.Fields(10).Value
MASTER.Fields(11).Value = Admin.Fields(11).Value
MASTER.Fields(12).Value = Admin.Fields(12).Value
MASTER.Update
Admin.MoveNext

Although changing "admin" to respective name as you said.

Lastly I get user defined error on
cnAdmin As New ADODB.Connection
I use Office 2010. Do I need to enable something in references?

Thanks Deyken,


Stewart

deyken
10-05-2010, 08:04 AM
Hi Stewart,

1. I am not sure exactly which File functions are available in VBA, but after thinking about it, since you mentioned the file paths (to your network drive) will remain constant, simply go to the network folder(s) and copy/paste your own file path in between the quotes. I.e. say your network path to the "admin" folder is "X:\Documents\admin\admin.xls" then copy that complete path into the fileADMIN variable assignment. Do the same for all the rest of them.

2. Copy/Paste the While...wend blocks for each "table". I.e. Where I already had Admin, now simply create a While..wend block, renaming the subsequent "Admin.Fields(0).Value" lines to each table name, like "Finance.Fields(0).Value" and so on.

3. I completely forgot to mention that you will certainly require a reference to your version's ADO Type Libraries. Simply go to Tools | References.. on the Main Menu and check each box next to the "Microsfot ActiveX Data Objects" libraries. Your Office version will likely have different file versions than mine. Mine are version 2.8.

4. Forgive me, but it seems that I forgot a very important piece of output for you. Please add the following block of code at the very bottom of the Sub:

' 4. Display the imported Data on the MASTER EXCEL WORKSHEET
' We will use the amount of rows for the amount of records now sitting in the MASTER "table"
Dim i, StartRow, EndRow As Integer

StartRow = 2 ' Due to Row 1 being Headers
EndRow = StartRow + MASTER.RecordCount

MASTER.MoveFirst
For i = StartRow To EndRow
With Sheet2
.Cells(i, "A") = MASTER.Fields(0).Value
.Cells(i, "B") = MASTER.Fields(1).Value
.Cells(i, "C") = MASTER.Fields(2).Value
.Cells(i, "D") = MASTER.Fields(3).Value
.Cells(i, "E") = MASTER.Fields(4).Value
.Cells(i, "F") = MASTER.Fields(5).Value
.Cells(i, "G") = MASTER.Fields(6).Value
.Cells(i, "H") = MASTER.Fields(7).Value
.Cells(i, "I") = MASTER.Fields(8).Value
.Cells(i, "J") = MASTER.Fields(9).Value
.Cells(i, "K") = MASTER.Fields(10).Value
.Cells(i, "L") = MASTER.Fields(11).Value
End With
Next i

--> This actually iterates through the entire new MASTER Recordset and actually prints/displays the data collected into your MASTER CONSOLIDATED DATABASE Sheet.

Hope this makes a little more sense now ;)

georgedaws
10-05-2010, 08:35 AM
Yes!

I though keeping a constant file path would be the most suitable way.

The "While to Wed" is crystal clear now, thanks.

I will go and check my references box.

(I am learning so much on here)

Thanks for the last piece of code Deyken,

Should put the cherry on the top!

I will let you know how I go!


Thanks buds,

Stewart

frank_m
10-05-2010, 09:13 AM
Hi Deyken,

something minor to mention... In vba declaring the data type only once at the end only effects the last Variable. ( i and StartRow will default to Variants )
Dim i, StartRow, EndRow As Integer Should be
Dim i As Integer, StartRow As Integer, EndRow As Integer

:beerchug:

georgedaws
10-05-2010, 09:56 AM
Hi Deyken,

I have placed all the code into a module and I have amended all code accordingly.

I ran the macro through command button and I have error returned "type mismatch on th "+" sign of this part of the code

EndRow = StartRow + MASTER.RecordCount

Could you tell me what could be wrong.

Thank you, nearly there!

Stewart

georgedaws
10-05-2010, 10:10 AM
I think I may have found why I had the error.

I replaced the codeDim i, StartRow, EndRow As Integer

With Frank M's

Dim i As Integer, StartRow As Integer, EndRow As Integer

Which gave me the above error.
So I reverted back to see if it would correct itself.

I then ran the code again and I recieved an error message;

Run time error.
Microsoft ODBC Driver Manager data source name not found and no default driver specified.

This part of the code was then highlighted;
cnAdmin.Open "Driver={Microsoft Excel Driver (*.xls)};DriverId=790;Dbq=" & fileADMIN & ";DefaultDir=" & fileADMIN & ";"

Now I don't know if this made any difference but I had a lot of choices in tools/references "microsoft active x data objects library" and I chose the highest listed that was 6.0

Just thuoght I should let you know exactly what I have done mate.

Thanks Deyken,

Stewart

deyken
10-05-2010, 10:26 PM
Hi Deyken,

something minor to mention... In vba declaring the data type only once at the end only effects the last Variable. ( i and StartRow will default to Variants )
Dim i, StartRow, EndRow As Integer Should be
Dim i As Integer, StartRow As Integer, EndRow As Integer

:beerchug:

Hi Frank,

Thanks a bunch. I did not even know that. In Delphi when you declare multiple variables on a single line for a certain data type then it is compiled as just that. Apparently the VBA compiler needs some more meat on its bones :)

This actually solves a ton of minor issues I've been having lately! LOL!!

Thanks a million!

deyken
10-05-2010, 11:19 PM
Hi Frank!

I am actually having a strange hassle with my code here. When attempting to open the Worksheet named "MASTER_DB" in my connection string, as below, I get the "Cannot find object named..." error.

Am I doing some thing wrong here??

Connection String:
cnMASTER.Open "Driver={Microsoft Excel Driver (*.xls)};DriverId=790;Dbq=" & fileMASTER & ";DefaultDir=" & fileMASTER & ";"

Opening Recordset:

MASTER.Open "Select * FROM [MASTER_DB$]", cnMASTER, adOpenDynamic, adLockOptimistic

georgedaws
10-06-2010, 03:59 AM
Hi Deyken,

Have you had any luck with the code?

I have tried searching myself but the answers I have found do not seem relevant to my problem.

Thanks,


Stewart

frank_m
10-06-2010, 10:33 AM
Hi Deyken,

Sorry, but I am not going to be able to assist you with that. My skills are on the low end of intermediate, plus I have not worked with connection strings or ADO for a few years.