PDA

View Full Version : Convert Excel Worksheets into Database



idledebonair
02-29-2008, 11:16 PM
So...

My boss, before I started working for him, thought it would be a good idea to use Excel as a database and as a Word Processor. So for our little retail shop he set up all the invoices in Excel. With each new invoice he created a new worksheet. Well now we have several hundred (near a thousand) worksheets that also serve as the printed out invoice. Which is convenient when you don't want to deal with a real database and forms; but it is extremely inconvenient when you want to bash that data into anything else usable.

So what I need to do is pull data from about 70 cells scattered around a worksheet, for every worksheet. Fortunately, the data are in the same cells on every worksheet.

I tried to write a macro that would copy the cells from each worksheet and place them in neat rows and columns so i could easily turn that into a database in access. But I quickly learned I don't know what the heck I'm doing.

Can anyone think of a good way to do this?

Bob Phillips
03-01-2008, 02:45 AM
A number of things you need to do.

First, create a worksheet for the data



Set dataWS = Worksheets.Add.Name = "Data"


then you need to loop through all of the other worksheets to get the data


For Each sh In ActiveWorkbook.Worksheets

Next sh


but you want to ignore the new worksheet, that is not to be included


For Each sh In ActiveWorkbook.Worksheets

If sh.Name <> "Data" Then

End If
Next sh


then you need to copy data across



For Each sh In ActiveWorkbook.Worksheets

If sh.Name <> "Data" Then

NextRow = NextRow + 1
sh.Range("A1").Copy dataWS.Cells(NextRow, "A")
sh.Range("C5").Copy dataWS.Cells(NextRow, "B")
sh.Range("H9").Copy dataWS.Cells(NextRow, "C")
'etc
End If
Next sh


and finally you delete the other sheets




Application.DisplayAlerts = False
For Each sh In ActiveWorkbook.Worksheets

If sh.Name <> "Data" Then

sh.Delete
End If
Next sh
Application.DisplayAlerts = True


the DisplayAlerts stuff is just to stop you getting messages about deleting the worksheet.

BUT TAKE A COPY before you destroy all of thata data.

matthewspatrick
03-01-2008, 01:49 PM
Bob's given you excellent advice to get started. Some other thoughts...

Make sure you put a lot of thought into a normalized, relational data model. That data model should be informed by the kind of reporting and analysis you expect to be doing later.

And as Bob says, make damn sure you have a clean backup of everything before you get started :)

Bob Phillips
03-01-2008, 02:08 PM
Patrick,

If he is using Excel as a databse, I would suggest that a normalised relational model is the last thing he wants. In my experience, it is far simpler to have all the data on a single row, lots of redundancy, poor entity modelling, poor abstraction of business dimensions, but a lot easier to work with.

idledebonair
03-03-2008, 08:30 AM
I get a Type Mismatch error 13 on Set dataWS = Worksheets.Add.Name = "Data"

What am I doing wrong?

idledebonair
03-03-2008, 09:45 AM
Ok, to get around the Type Mismatch error, I simply created the Data worksheet myself and changed the beginning of the script to:

Sub Macro1()
Application.DisplayAlerts = False
Set dataWS = Worksheets("Data")

For Each sh In ActiveWorkbook.Worksheets

But now I'm having a problem because the source data cells have internal references and If/Then statements and all kinds of goofy things going on. Is there a way to modify the function that copies the data to just copy the displayed result, and not what is entered into the cell?

tstav
03-03-2008, 10:04 AM
Maybe this might help
Just enter the cell addresses you want to copy

Sub CellsFromSheets()
'----------------------------------------------------
'First create a new Worksheet
'Then copy the cell values e.g. A20, B25, C2, D10 etc
'I'm also copying the names of the Worksheets across,
'as well as the addresses of the copied cells
'so that you can cross-check the results
'----------------------------------------------------
Dim S, Sht As Worksheet
Dim cell As Range
Dim i, titleRow, newRow, newCol As Integer
Set Sht = Worksheets.Add
newRow = 1
titleRow = 1
For Each S In ThisWorkbook.Worksheets
If S.Name <> Sht.Name Then
newRow = newRow + 1
newCol = 1
'The name of the Worksheet being copied
Sht.Cells(newRow, newCol).Value = S.Name

newCol = newCol + 1
'The address of the cell being copied
Sht.Cells(titleRow, newCol).Value = _
Replace(S.Range("A2").Address, "$", "")

'The value of the cell being copied
Sht.Cells(newRow, newCol).Value = _
S.Range("A2").Value

newCol = newCol + 1
Sht.Cells(titleRow, newCol).Value = _
Replace(S.Range("B25").Address, "$", "")

Sht.Cells(newRow, newCol).Value = _
S.Range("B25").Value

newCol = newCol + 1
Sht.Cells(titleRow, newCol).Value = _
Replace(S.Range("C2").Address, "$", "")

Sht.Cells(newRow, newCol).Value = _
S.Range("C2").Value
'...and so on <--- add here the rest of your cell addresses
End If
Next
ActiveSheet.Cells.EntireColumn.AutoFit
End Sub

You can delete the Worksheets manually after you have made sure that data has been copied across correctly

Bob Phillips
03-03-2008, 10:06 AM
Yeah, grab the text property



For Each sh In ActiveWorkbook.Worksheets

If sh.Name <> "Data" Then

NextRow = NextRow + 1
sh.Range("A1").Copy dataWS.Cells(NextRow, "A") .Text
sh.Range("C5").Copy dataWS.Cells(NextRow, "B") .Text
sh.Range("H9").Copy dataWS.Cells(NextRow, "C") .Text
'etc
End If
Next sh

idledebonair
03-03-2008, 10:15 AM
Yeah, grab the text property



For Each sh In ActiveWorkbook.Worksheets

If sh.Name <> "Data" Then

NextRow = NextRow + 1
sh.Range("A1").Copy dataWS.Cells(NextRow, "A") .Text
sh.Range("C5").Copy dataWS.Cells(NextRow, "B") .Text
sh.Range("H9").Copy dataWS.Cells(NextRow, "C") .Text
'etc
End If
Next sh



When I try to run it like this with the space before .Text, I get a Compile Error, Expected: end of statement. When I run it without the space, I get a Run Time error: 1004 Copy method of Range class failed

idledebonair
03-03-2008, 10:17 AM
@tstav: I will try your coding if we can't get xld's to work, because there are about a hundred different cells and I've already typed them in once in that format, so if possible, i'd like to just modify the existing code somehow. Thanks!

Bob Phillips
03-03-2008, 10:21 AM
Sorry, made a bit of a pig of that. Try this



For Each sh In ActiveWorkbook.Worksheets

If sh.Name <> "Data" Then

NextRow = NextRow + 1
sh.Range("A1").Copy
dataWS.Cells(NextRow, "A").PasteSpecial Paste:=xlValues
sh.Range("C5").Copy
dataWS.Cells(NextRow, "B").PasteSpecial Paste:=xlValues
sh.Range("H9").Copy
dataWS.Cells(NextRow, "C").PasteSpecial Paste:=xlValues
'etc
End If
Next sh

Bob Phillips
03-03-2008, 10:24 AM
or even this, which is what I intended in thefirst place



For Each sh In ActiveWorkbook.Worksheets

If sh.Name <> "Data" Then

NextRow = NextRow + 1
dataWS.Cells(NextRow, "A").Value = sh.Range("A1").Text
dataWS.Cells(NextRow, "B").Value = sh.Range("C5").Text
dataWS.Cells(NextRow, "C").Value = sh.Range("H9").Text
'etc
End If
Next sh

idledebonair
03-03-2008, 11:35 AM
Thanks. Works perfectly!