Solved

SQL to Excel template using name range

Posted on 2014-01-22
10
416 Views
Last Modified: 2014-01-23
Hi,

I need to get data from SQL to an Excel template, EE showed me using name range, I got to a point that I can get the data to "fixed" name range.  

But if I need to return a record set from SQL and loop through it and display on the excel, it overwrites whatever is in the path, how can I "push" them down?  thanks
0
Comment
Question by:mcrmg
  • 6
  • 4
10 Comments
 
LVL 14

Expert Comment

by:Zack Barresse
ID: 39801298
Hi there,

If you use tables you can just return the recordset to the data body range and the table will adjust rows as needed. Or are you trying to not overwrite previous data, can you explain? How exactly are you getting the SQL data into Excel? Also, what version of Excel are you using?

Regards,
Zack Barresse
0
 

Author Comment

by:mcrmg
ID: 39801518
Hi,

This is the test file I am using to get the data, also, I upload a test template, as you can see, if a recordset displays on the first header, the second one will be replaced.  In ideal situation would be push the second one down...not sure if this is doable..thanks


Sub getData()
Dim conn As Variant
Dim rs As Variant
Dim cs As String
Dim query As String
Dim row As Integer



   Dim Wb1 As Workbook
   Dim Wb2 As Workbook
     
   Set Wb1 = ActiveWorkbook
   
   Set Wb2 = Workbooks.Open("book1.xlsx")



Set conn = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")


cs = "DRIVER=SQL Server;"
cs = cs & "DATABASE=test;"
cs = cs & "SERVER=192.168.1.20,1433"

conn.Open cs, "username", "pwd"

query = "select * from dbo.users"
'query = "select * from dbo.users Where UserName = 'abc'"
rs.Open query, conn


'+++++++++++
Wb2.Worksheets("Sheet1").Range("city") = rs.Fields("name1").Value
'+++++++++++


'***********
row = 0
Do Until rs.EOF
row = row + 1
Wb2.Worksheets("Sheet1").Cells(row, 3).Value = rs.Fields("name1").Value
'Wb1.Sheets("Sheet1").Cells(row, 2).Value = rs.Fields("name2").Value
rs.movenext
Loop
'***********




rs.Close
Set rs = Nothing

conn.Close
Set conn = Nothing

End Sub
0
 

Author Comment

by:mcrmg
ID: 39801523
file
Book1.xlsx
0
 
LVL 14

Accepted Solution

by:
Zack Barresse earned 500 total points
ID: 39801708
If you want to return a query to append data in an Excel worksheet, the basic premise is like this...
    Dim WS                      As Worksheet
    Dim LastRow                 As Long
    Set WS = Wb2.Worksheets("Sheet1")
    LastRow = WS.Cells(WS.Rows.Count, 3).End(xlUp).Row
    WS.Cells(LastRow + 1, 3).CopyFromRecordset rs

Open in new window

But your code doesn't look like it's appending, or is that the question?

Here is an example I use to extract data from a SQL server (using the local AdventureWorks2012), which has an append data variable. I adjusted a few variables for your code, but it's still the same, it just takes the query and appends it as applicable. If the sheet is blank it adds the headers, otherwise it appends the query to the first open row in the specified column...
Sub testAppend()
    Call RetreiveSqlData(True)
End Sub

Sub RetreiveSqlData(Optional ByVal AppendData As Boolean = False)

    Const StartCol              As Long = 3
    
    Dim conn                    As Object
    Dim RS                      As Object
    Dim WB                      As Workbook
    Dim WS                      As Worksheet
    Dim LastRow                 As Long

    Set WB = ActiveWorkbook
    Set WS = WB.Worksheets("Sheet1")
    If WS.ProtectContents = True Then GoTo SheetProtected

    On Error GoTo ConnError
    Set conn = CreateObject("ADODB.Connection")
    conn.Open "Provider=SQLOLEDB;" & _
              "Data Source=ZACKDEV2;" & _
              "Persist Security Info=False;" & _
              "Initial Catalog=AdventureWorks2012;" & _
              "Trusted_Connection=Yes;"
    On Error GoTo 0

    On Error GoTo RecordsetError
    Set RS = CreateObject("ADODB.Recordset")
    RS.Open "SELECT * FROM Person.Person", conn
    On Error GoTo 0

    If AppendData = False Then
        WS.Cells.Clear
    End If

    LastRow = WS.Cells(WS.Rows.Count, 3).End(xlUp).Row
    If ISWSBLANK(WS) = True Then
        Call ADDHEADERS(RS, WS, 1, StartCol)
    End If
    If WSHASROOM(WS, RS.RecordCount, LastRow + 1, WS.Rows.Count) = False Then GoTo NoRoom
    WS.Cells(LastRow + 1, StartCol).CopyFromRecordset RS

    MsgBox "Recordset returned successfully.", vbInformation, "Success!"

GoodExit:
    On Error Resume Next
    Set WS = Nothing
    Set WB = Nothing
    Set RS = Nothing
    conn.Close
    Set conn = Nothing
    On Error GoTo 0
    Exit Sub

    '**************************************************************************************

ConnError:
    MsgBox "Could not connect to SQL database.", vbExclamation, "Whoops!"
    GoTo GoodExit

RecordsetError:
    MsgBox "Could not retreive the recordset.", vbExclamation, "Whoops!"
    GoTo GoodExit

NoRoom:
    MsgBox "There isn't enough room to fit the recordset.", vbExclamation, "Whoops!"
    GoTo GoodExit

SheetProtected:
    MsgBox "The destination sheet is protected.", vbExclamation, "Whoops!"
    GoTo GoodExit
    '**************************************************************************************

End Sub

Function ISWSBLANK(ByVal WKS As Worksheet) As Boolean
    ISWSBLANK = CBool(WorksheetFunction.CountA(WKS.Cells) = 0)
End Function

Function WSHASROOM(ByVal WKS As Worksheet, _
                   ByVal RowCount As Long, _
                   Optional ByVal StartRow As Long, _
                   Optional ByVal EndRow As Long)
    If StartRow = 0 Then StartRow = 2
    If EndRow = 0 Then EndRow = WKS.Rows.Count
    WSHASROOM = CBool(RowCount <= EndRow - StartRow + 1)
End Function

Sub ADDHEADERS(ByVal RST As Object, _
               ByVal WKS As Worksheet, _
               Optional ByVal StartRow As Long = 1, _
               Optional ByVal StartCol As Long = 1)
    Dim FieldsCnt               As Long
    For FieldsCnt = 0 To RST.Fields.Count - 1
        WKS.Cells(StartRow, StartCol + FieldsCnt).Value = RST.Fields(FieldsCnt).Name
    Next FieldsCnt
End Sub

Open in new window


This is using late binding with an ADO method. Let us know if this helps.

Zack
0
 

Author Comment

by:mcrmg
ID: 39801784
Hi,
Thank you for the sample code.  The second part is petty advanced. Lol

What I am trying to do is to run the code fresh
Everytime, not to append data.  In my file, if the first rs has 20 rows, header address should be pushed down 20 rows.  

I am sorry if my description is not clear.  Thx
0
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
LVL 14

Assisted Solution

by:Zack Barresse
Zack Barresse earned 500 total points
ID: 39801788
So push down headers and all? I'd check the RecordCount property of the recordset before you attempted to shift/insert cells, which would avoid an error. But assuming your data is in row 1, so like A1:A20 (however many columns), you could just insert the number of rows as your recordset has (plus one for a space)...

rows(1).resize(rs.recordcount + 1).insert

Open in new window


Then just do a copyfromrecordset to Range("A1") or something. Is that what you're looking for? Sorry if I misunderstood.

Edit: It would be + 2 if you plan on putting the headers in as well.

Zack
0
 

Author Comment

by:mcrmg
ID: 39802886
Hi,

This is what I have so far
For Cols = 0 To rs.Fields.Count - 1
    Wb2.Worksheets("Sheet1").Cells(1, Cols + 1).Value = rs.Fields(Cols).Name
Next

Wb2.Worksheets("Sheet1").Range("A2").CopyFromRecordset rs

Open in new window


I could get the rs count +1 or +2 and start to display second rs after the first rs.  But, some of the headers on the template has different name than the name in db, for example, it will say "First Name" on the template, but I named it "FirstName" in db, plus, it might have format, color on the template.   So, I am not sure if name range would be the solution.

Sorry to keep bothering you.  thx
0
 
LVL 14

Expert Comment

by:Zack Barresse
ID: 39802993
I'm not really sure why you keep talking about a named range. You have data set #1, which is on your worksheet. You want to bring in data set #2 from SQL. Assuming everything is the same, fields/columns are the same, etc, and you wanted the new data set #2 above your data set #1, you could insert rows between the header and the first row of data set #1, then put data set #2 directly below the header.

If you wanted the new data set #2 below data set #1, it's as simple as finding the last row after data set #1 and returning data set #2 to that location.

In either case, you must fully describe what it is you have to start as well as what you want for the end result. I'm afraid I'm only getting more confused.  Perhaps a before/after workbook or picture would help.

Zack
0
 

Author Comment

by:mcrmg
ID: 39803047
I am very sorry to confuse you.

The template has nothing but 5 rows of headers with colors and fonts.  
row 1 - 4 has logo, date, report name, etc...
header 1 is on row 5
header 2 is on row 6
header 3 is on row 7
header 4 is on row 8
header 5 is on row 9

Each header represents one rs.  I need to bring 5 rs back from sql with different queries.
I can not use firldnames from the sql because they are different than the header name on the template.  

I am hoping this would clear things up.  thx
0
 

Author Comment

by:mcrmg
ID: 39803546
I think I ve got it so far...thank you
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Drop Down List with Unique/Distinct Values (Part II - ComboBox or ListBox and Data Validation List Bonus!) David Miller (dlmille) Intro This article focuses on delivering unique, sorted lists to list objects (e.g., ComboBox, ListBox) and Dat…
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

895 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now