database data into spreadsheet

[Melissa]

I need to create new spreadhseet, based on the master database cell.
Example:
Apples - 10
Banana - 20
Apples - 30
Banana - 50

To return a list of all apples with the numbers into a new spreadsheet, then
Bananas ...
Example: Apples Tab
Apples -10
Apples -30

How can I do that?

 

[RB Smissaert]

Try something like this:

Sub test()

Dim i As Long
Dim LR As Long
Dim LR2 As Long
Dim arr

LR = Cells(65536, 1).End(xlUp).Row
arr = Range(Cells(1), Cells(LR, 2))

For i = 1 To LR
If SheetExists(arr(i, 1)) Then
With Sheets(arr(i, 1))
LR2 = .Cells(65536, 1).End(xlUp).Row + 1
.Cells(LR2, 1) = arr(i, 1)
.Cells(LR2, 2) = arr(i, 2)
End With
Else
Sheets.Add , ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
ActiveSheet.Name = arr(i, 1)
Cells(1) = arr(i, 1)
Cells(2) = arr(i, 2)
End If
Next i

End Sub

Function SheetExists(ByVal strSheetName As String) As Boolean

Dim x As Object

On Error Resume Next
Set x = ActiveWorkbook.Sheets(strSheetName)

If Err = 0 Then
SheetExists = True
End If

End Function


RBS

 

[Patrick Molloy]

I replied in an earlier question....probably withing the past week, to a
query whereby I sent code in that selects unique items from a column in an
excel database, then returns all the data , per item into a new sheet, with
the sheet name = item.

fyi here is the code, but you should search for the query to put it into
context

1) The file exceldatabase.xls has a table, rangenamed "testdata" with
several columns of data, one column is PROD. Please create a file like this.
How many other columns doesn't matter , so long as one is geaded PROD and teh
range is defined. The code witj get unique values from thi scolumn, so be
sure that whatever values you have, would be ok as sheet tab names - I didn't
bother with error handling to avoid clutter

2) open a new excel workbook and put this code into a standard module -
from teh development environment, menu INSERT / Module

Option Explicit
Sub LoadFromExcelDatabase()
Dim Conn As ADODB.Connection
Dim RST As ADODB.Recordset
Dim RST1 As ADODB.Recordset
Dim strConn As String
Dim SQL As String
Dim ws As Worksheet
Dim cl As Long

Dim sExcelSourceFile As String

sExcelSourceFile = "E:\Excel\Excel_database\Testdatabase.xls"

strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel
8.0;"
strConn = strConn & "Data Source="
strConn = strConn & sExcelSourceFile

Set Conn = New ADODB.Connection
Conn.Open strConn

Set RST = New ADODB.Recordset
Set RST1 = New ADODB.Recordset
SQL = "SELECT DISTINCT [PROD] FROM testdata"

RST.Open SQL, Conn, adOpenStatic

Do Until RST.EOF
SQL = "SELECT * from testdata where [PROD]='" & RST.Fields(0) & "'"
RST1.Open SQL, Conn, adOpenStatic

Set ws = Worksheets.Add
ws.Name = RST.Fields(0)

For cl = 1 To RST1.Fields.Count
ws.Cells(1, cl).Value = RST1.Fields(cl - 1).Name
Next
ws.Range("A2").CopyFromRecordset RST1
RST1.Close
Set ws = Nothing

RST.MoveNext
Loop


RST.Close

Conn.Close

Set RST = Nothing
Set RST1 = Nothing
Set Conn = Nothing

End Sub