Click here to Skip to main content
15,881,600 members
Please Sign up or sign in to vote.
0.00/5 (No votes)
See more:
Hi,right now I already create new Excel workbook. BUT, I want to split the data to new worksheet based on column.

In my case, at the first sheet, it has 3 column:: Name, Order and Price.

And, I want column Name for value 'Lucy' remain same worksheet and value 'Amir' will be in new worksheet.

Currently, I have this coding code that create new Excel. I don't have any idea how to start code for add new worksheet. Is it related with 'loop' or 'if-else then'

HTML
Dim Rsx As New ADODB.Recordset
        
Dim data2Rs As New ADODB.Recordset
sqlreport = qryline
Debug.Print sqlreport
Dim rsReport As ADODB.Recordset
Set rsReport = New ADODB.Recordset
   
Dim warehsecol As Integer, intRow As Integer, intCol As Integer, oricolidx As Integer

rsReport.Open sqlreport, wsDB
Debug.Print sqlreport

If rsReport.EOF Then 'no record
    xrecord = "N"

Else 'record exists
    xrecord = "Y"
    
    Dim excelApp As New excel.Application       
    Dim wbReport As Workbook
    Dim wsReport As Worksheet
    Dim rejRs As ADODB.Recordset

    excelApp.Visible = False
    excelApp.ScreenUpdating = False
    excelApp.Interactive = False
    excelApp.IgnoreRemoteRequests = True
    
    Set wbReport = excelApp.Workbooks.Add
    Set wsReport = wbReport.ActiveSheet
    
    '***Formatting
    With wsReport
        .Cells(2, 2).Value = "NAME"
        .Cells(2, 3).Value = "ORDER"
        .Cells(2, 4).Value = "PRICE"

        .Rows(4).Font.Bold = True
        .Rows(4).Font.Color = vbBlue

        intRow = 6 'Starting row# for data insertion
    
        reccount = 0
        Do While Not rsReport.EOF
            reccount = reccount + 1
            reccount.Refresh

            .Cells(intRow, 2).Value = Trim(rsReport!name)
            .Cells(intRow, 3).Value = Trim(rsReport!order)
            .Cells(intRow, 4).Value = Trim(rsReport!price)

            intRow = intRow + 1
                
            rsReport.MoveNext
        Loop
             
        .Range("A1").Select
    End With
    wsReport.UsedRange.Columns.AutoFit
End If
'---------------------------
rsReport.Close
Set rsReport = Nothing

wsReport.UsedRange.Columns.AutoFit
wbReport.SaveAs "C:\report\" & "sale".xlsx"
wbReport.Close


What I have tried:

I try change the coding from
Set wbReport = excelApp.Workbooks.Add
    Set wsReport = wbReport.ActiveSheet

to
Set wbReport = excelApp.Workbooks.Add
    Set wsReport = wbReport.Worksheets.Add

And it appears 2 sheets. But, how i can split the data into another sheets.

Please help me with the coding.
Posted
Updated 22-Aug-22 8:39am

Well... i'd simplify that... The idea is as follow:

VB
rsReport.Open sqlreportForNameLucy, wsDB
'then...
wbReportForNameLucy.Range("A2").CopyFromRecordset rsReport

rsReport.Open sqlreportForNameAmir, wsDB
'then...
wbReportForNameAmir.Range("A2").CopyFromRecordset rsReport


Got it?

If you would like to add column headers, use function:
VB
Function AddRsHeaders(ws As Worksheet, rs As Recordset)
    For iCols = 0 to rs.Fields.Count - 1 
        ws.Cells(1, iCols + 1).Value = rs.Fields(iCols).Name 
    Next 
End Function

Then call it from main function/procedure.

More details you'lll find at: Range.CopyFromRecordset method (Excel) | Microsoft Docs[^]
 
Share this answer
 
v4
Comments
CHill60 22-Aug-22 16:21pm    
Agreed, better approach is to use the sql to do the separation!
We may end up helping the OP change the sql tho
Maciej Los 23-Aug-22 0:18am    
Thank you, Caroline.
Member 14670863 23-Aug-22 22:01pm    
Yeah, thanks. I successfully can split the data. Thanks for your idea and guide. :)
Set up variables for each sheet and initialise them e.g.
VB
Dim wsReportLucy As Worksheet, wsReportAmir As Worksheet
    
        Set wbReport = excelApp.Workbooks.Add
        Set wsReportLucy = wbReport.ActiveSheet 'Sheet1
        wsReportLucy.Name = "Lucy"
        Set wsReportAmir = wbReport.Sheets.Add
        wsReportAmir.Name = "Amir"
        
        '***Formatting
        With wsReportLucy
            .Cells(2, 2).Value = "NAME"
            .Cells(2, 3).Value = "ORDER"
            .Cells(2, 4).Value = "PRICE"
    
            .Rows(4).Font.Bold = True
            .Rows(4).Font.Color = vbBlue
        End With
        
        With wsReportAmir
            .Cells(2, 2).Value = "NAME"
            .Cells(2, 3).Value = "ORDER"
            .Cells(2, 4).Value = "PRICE"
    
            .Rows(4).Font.Bold = True
            .Rows(4).Font.Color = vbBlue
        End With
Have a counter of rows for each sheet e.g.
VB
Dim intRowLucy As Integer, intRowAmir As Integer
        intRowLucy = 6
        intRowAmir = 6
Then just check the name as you loop through the recordset e.g.
VB
Do While Not rsReport.EOF
    
            'Use Case if there are a lot of names
            If rsReport!Name = "Amir" Then
                intRowAmir = WriteData(wsReportAmir, wsReportAmir, intRowAmir)
                                
            ElseIf rsReport!Name = "Lucy" Then
                intRowAmir = WriteData(wsReportLucy, wsReportLucy, intRowLucy)

            End If
            
            rsReport.MoveNext
        Loop
Where I have created a small function to handle actually writing the data e.g.
VB
Private Function WriteData(rs As ADODB.Recordset, ws As Worksheet, intRow As Integer) As Integer

    With ws
        .Cells(intRow, 2).Value = Trim(rsReport!Name)
        .Cells(intRow, 3).Value = Trim(rsReport!Order)
        .Cells(intRow, 4).Value = Trim(rsReport!Price)
    End With

    WriteData = intRow + 1
End Function
 
Share this answer
 
Comments
Maciej Los 22-Aug-22 14:48pm    
Caroline, i found this example quite complicated. There's an easier way to achieve that. Please, see my answer.
Member 14670863 23-Aug-22 21:59pm    
Thanks. I discover a little bit how to do it. And successfully done split the data by comparing your code. Thanks a lot :)

This content, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)



CodeProject, 20 Bay Street, 11th Floor Toronto, Ontario, Canada M5J 2N8 +1 (416) 849-8900