Convert Excel Worksheets into Database

[idledebonair]

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]

A number of things you need to do.

First, create a worksheet for the data

[vba]

Set dataWS = Worksheets.Add.Name = "Data"
[/vba]

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

[vba]
For Each sh In ActiveWorkbook.Worksheets

Next sh
[/vba]

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

[vba]
For Each sh In ActiveWorkbook.Worksheets

If sh.Name <> "Data" Then

End If
Next sh
[/vba]

then you need to copy data across

[vba]

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
[/vba]

and finally you delete the other sheets

[vba]


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

If sh.Name <> "Data" Then

sh.Delete
End If
Next sh
Application.DisplayAlerts = True
[/vba]

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]

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]

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]

I get a Type Mismatch error 13 on Set dataWS = Worksheets.Add.Name = "Data"

What am I doing wrong?

[idledebonair]

Ok, to get around the Type Mismatch error, I simply created the Data worksheet myself and changed the beginning of the script to:

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

For Each sh In ActiveWorkbook.Worksheets[/VBA]

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]

Maybe this might help
Just enter the cell addresses you want to copy
[vba]
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[/vba]

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

[Bob Phillips]

Yeah, grab the text property

[vba]

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
[/vba]

[idledebonair]

Yeah, grab the text property

[vba]

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
[/vba]

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]

@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]

Sorry, made a bit of a pig of that. Try this

[vba]

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
[/vba]

[Bob Phillips]

or even this, which is what I intended in thefirst place

[vba]

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
[/vba]

[idledebonair]

Thanks. Works perfectly!