How to have my results in different sheets in one workbook?

Closed
wilnap Posts 1 Registration date Monday March 14, 2016 Status Member Last seen March 14, 2016 - Mar 14, 2016 at 03:28 PM
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 - Mar 15, 2016 at 12:55 PM
Good day

I trust you are well? I was hoping you can assist me with the following and will be most grateful for any help I can get:

I have to create a report in Excel, running from a SQL Stored Procedure. The data consists of Sales Data by Month based on the last 12 months. I need the data to be in 12 separate Worksheets on the same Workbook, and if possible have the Worksheets named as per the different months as per the data returned. I may have a master sheet with all the data, but ideally it would be great if it was possible to just split the results away.

I have a Module with the code to run the stored procedure and was wondering how to may be either add the code for above in or either add another module to spilt the data in the the twelve sheets.

I will be most grateful for any help and thank you in advance.

I will add examples below:

The module code:


Option Explicit
Dim cnn As ADODB.Connection
Dim strCnn As String

Private Function ConnectionOK() As Boolean
On Error GoTo MyErrorHandler
If cnn Is Nothing Then
Set cnn = New ADODB.Connection
cnn.ConnectionString = "Provider=SQLOLEDB;SERVER=XXXXXX\ZZZZZ;database=AAAA;UID=EEEEE;Pwd=OOOO"

cnn.Open
Else
'if cnn.state =
End If
ConnectionOK = True

MyExit:
Exit Function

MyErrorHandler:
MsgBox Err.Description
ConnectionOK = False
Resume MyExit

End Function

Public Function CloseConnection()
cnn.Close
Set cnn = Nothing
End Function


Public Sub RefreshData_DATA()
Dim rst As ADODB.Recordset, strSQL As String
If MsgBox("Retrieve fresh load data from SAGE database?", vbQuestion + vbOKCancel) = vbCancel Then
Exit Sub
End If
Dim oldStatusBar As Boolean
oldStatusBar = Application.DisplayStatusBar

If ConnectionOK() Then
cnn.CommandTimeout = 300000 'Wild guess to sidestep timeout
Application.DisplayStatusBar = True
Application.StatusBar = "Extracting data from database..."

strSQL = Worksheets("DBQUERY").Range("A3").Value



Set rst = New ADODB.Recordset
rst.Open strSQL, cnn, adOpenForwardOnly, adLockReadOnly
rst.MoveFirst
If rst.RecordCount = 0 Then
MsgBox ("No data retrieved from database")
GoTo MyExit
End If
Application.StatusBar = "Inserting data into spreadsheet..."

'Clear out old data

Sheets("DATA").Select
Range("A12:BE65536").Select



Selection.ClearContents
Range("A12").Select

'Paste from recordset

Dim myRow As Long
myRow = 11
Dim myCol As Long
While Not rst.EOF
myRow = myRow + 1
For myCol = 1 To 13
Worksheets("DATA").Cells(myRow, myCol).Value = rst(myCol - 1)
Next myCol
rst.MoveNext
Wend

rst.Close
Set rst = Nothing


Worksheets("DATA").Cells(5, 1).Value = Now()

Else


End If
MyExit:
Application.StatusBar = False
Application.DisplayStatusBar = oldStatusBar

CloseConnection
Exit Sub

MyErrorHandler:
MsgBox Err.Description


End Sub

MyResult:

TRANSACTION NUM CPY CUSTOMER TR DATE REPORT MONTH MTH NR CUSTOMER NAME PRODUCT PRODUCT DESCRIPTION SALES COS MARGIN MARGIN %
PRES-SIN0023617 AFRICA C00000784 18/01/2016 January-2016 10 WEBSITE KIT00820 Littmann Stethoscope Classic III 5624 Hunter Green 120 0 120 1
PRES-SIN0023617 AFRICA C00000784 18/01/2016 February-2016 10 WEBSITE TRM00278 Littmann Stethoscope Classic III 5624 Hunter Green 0 93.6 -93.6 -93.6
PRES-SIN0023613 AFRICA C00000784 18/01/2016 March-2016 10 WEBSITE AER00463 Military Trauma Wound Dressing 10cm (Israeli Bandage) 33.81 28.419 5.391 0.159449
PRES-SIN0023613 AFRICA C00000784 18/01/2016 April-2016 10 WEBSITE AER00278 Reflective Thermal Blanket 127cm x 180cm ATB130 4.36 3.0892 1.2708 0.291467

1 response

TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 552
Mar 15, 2016 at 12:55 PM
Hi Wilnap,

Checking your "MyResult" data, I found the month to be in column E.
Make sure the month sheets are already there.

Then try the following code:
Sub RunMe()
Dim x As Integer
Sheets("Data").Select
x = 2
Do
    If Month(Cells(x, "E")) = 1 Then
        Rows(x).Copy _
        Sheets("January").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    ElseIf Month(Cells(x, "E")) = 2 Then
        Rows(x).Copy _
        Sheets("February").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    ElseIf Month(Cells(x, "E")) = 3 Then
        Rows(x).Copy _
        Sheets("March").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    ElseIf Month(Cells(x, "E")) = 4 Then
        Rows(x).Copy _
        Sheets("April").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    ElseIf Month(Cells(x, "E")) = 5 Then
        Rows(x).Copy _
        Sheets("May").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    ElseIf Month(Cells(x, "E")) = 6 Then
        Rows(x).Copy _
        Sheets("June").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    ElseIf Month(Cells(x, "E")) = 7 Then
        Rows(x).Copy _
        Sheets("July").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    ElseIf Month(Cells(x, "E")) = 8 Then
        Rows(x).Copy _
        Sheets("August").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    ElseIf Month(Cells(x, "E")) = 9 Then
        Rows(x).Copy _
        Sheets("September").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    ElseIf Month(Cells(x, "E")) = 10 Then
        Rows(x).Copy _
        Sheets("October").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    ElseIf Month(Cells(x, "E")) = 11 Then
        Rows(x).Copy _
        Sheets("November").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    ElseIf Month(Cells(x, "E")) = 12 Then
        Rows(x).Copy _
        Sheets("December").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    End If
    x = x + 1
Loop Until Cells(x, "E") = vbNullString
End Sub


Best regards,
Trowa
0