Free Microsoft Excel 2013 Quick Reference

If statement to pull values from another spreadsheet worksheet Results

I have two spreadsheets, i suppose one part of the solution may be to copy spreadsheet 2 into a new worksheet in spreadsheet 1, but this is my current situation:

Spreadsheet 1 has "Employee lastname" in column F, "Employee Firstname" in column G. Column A in this sheet needs updating with the data populated in column H for that employee in spreadsheet 2 - the lastname is contained in column B, firstname in column C - so i need to to a match.

There are over 1000 employees so don't want to rekey the data. Any help would be really appreciated.

I've now added a test spreadsheet - employees sheet column A needs updating with data in sheet1 column H forthe right person!!

I had been using Harlan Grove's PULL function in order to link to data in another workbook that wasn't necessarily currently
open in Excel.

The PULL function allows you to specify the details of your linked range as a cell value (unlike a direct link), similar to the
INDIRECT function. However, INDIRECT doesn't work with closed workbooks. I like Harlan's PULL function because the code is
open and can be easily copied and pasted into additional VBA workbooks as required so that no add-ins are needed. (I have not
had much experience with using INDIRECT.EXT via the MoreFunc add-in, although it is possible to "attach" MoreFunc to a workbook
so that functions can be used without the add-in being installed.)

The PULL function works well - however, it can be slow to use when returning large ranges of cells. For example, we had a
spreadsheet that was taking 5 minutes to update when using PULL to refer to a range of 3000 cells. So I looked into creating
an alternative function that would be more suited to my circumstance. I feel I was successful and wanted to share my findings
here, since the publishing of the PULL function was very helpful to me. (Harlan - I hope that you don't mind that I have used
some of your ideas in the new function.)

The PULL function uses the ExecuteExcel4Macro command to get values from a cell from a closed workbook. The LINKEDRANGE
function that I present here differs from PULL in that it actually opens the linked workbook (in a separate Excel instance,
since spreadsheets cannot be normally be opened in a UDF), gets the values it needs and closes the workbook.

LINKEDRANGE may be faster than PULL when returning ranges of values from linked workbooks. LINKEDRANGE may be slower than PULL
when returning single values or small ranges.

Furthermore, LINKEDRANGE can be used to link to named ranges that refer to a range of more than one cell. (PULL works with
named ranges that refer to a single-cell only.)

The VBA code and sample spreadsheets are located he
http://www3.sympatico.ca/sstackho/LinkedRange.zip

The .bas file can be used for easy importing into spreadsheets.

Although I have tested the code on a couple of machines, it certainly will not be as bulletproof as the PULL function. Harlan
has added several layers of armor to the PULL function over the years so that it works on more Excel versions and more
operating systems. Since I don't fully understand all of the error-checking logic in the PULL function, I wasn't comfortable
adding it to the LINKEDRANGE function. Harlan or anybody: please feel free to make this function better by adding any
additional logic as you see fit.

I will paste the code below, although it might not look very good with line-wrapping, etc. The code is also available at the
link above.

'-------------------------------------------------
'-------------------------------------------------

Option Explicit

Function LINKEDRANGE(Link As String) As Variant

' Developed by Shawn Stackhouse
' Inspired (and partially developed) by Harlan Grove and his PULL function
' that was in turn inspired by Bob Phillips and Laurent Longre
'-----------------------------------------------------------------
'This code is free software; you can redistribute it and/or modify
'it under the terms of the GNU General Public License as published
'by the Free Software Foundation; either version 2 of the License,
'or (at your option) any later version.
'-----------------------------------------------------------------

' Version History
'
' v1 - 2006-08-24
' v1.1 - 2006-08-25
' - changed structure to have the function accept a single input and split out the LINKREFERENCE logic to a separate
function
' - fixed problem with conflict between workbook-level and worksheet-level named ranges

' Purpose:
' This user-defined function can be used to get values from another spreadsheet, even if it is not open.
'
' This provides similar functionality to using regular Excel links, but allows the locations and names of
' linked workbooks to be specified via cells.
'
' LINKEDRANGE provides similar functionality to Harlan Grove's PULL function.
'
' LINKEDRANGE differs from Harlan Grove's PULL function in that LINKEDRANGE actually opens the linked workbook (in a
' separate Excel instance, since spreadsheets cannot be normally be opened in a UDF) to get the linked values.
' Furthermore, LINKEDRANGE can be used to link to named ranges that refer to more than one cell.
'
' LINKEDRANGE may be faster than PULL when returning ranges of values from linked workbooks. LINKEDRANGE may
' be slower than PULL when returning single values or small ranges.

' **** NOTE ****
' This function requires a full recalculation (Ctrl+Alt+F9) in order to update values

' Function Output:
' - a range of variable size
' - to return a range of cells, use LINKEDRANGE as a formula array (Ctrl+Shift+Enter)

Dim xlapp As Object, xlwb As Workbook, xlws As Worksheet
Dim r As Range, iChrPos As Long
Dim Directory As String, WorkbookName As String, WorksheetName As String, WorksheetRange As String
Dim NamedRangeRefersTo As String

On Error GoTo CleanUp

' Check to see if the referenced range is currently open in this Excel instance,
' by using an Evaluate function. If the function returns an error, then the
' range is not open (or the range is invalid).

' Do an EVALUATE on Link to see if the referenced range is currently open in this Excel instance.
' The Evaluate function will return an error if the range is not open
LINKEDRANGE = Evaluate(Link)

' If the range is not open (or invalid), an error will be returned from the above statement and
' the following section will be processed

If CStr(LINKEDRANGE) = CStr(CVErr(xlErrRef)) Then

' Let's decipher the Directory, WorkbookName, WorksheetName and WorksheetRange from the Link string.
' The Link string can be in a variety of formats.

' If the first character is not a single quote, then a Directory has not been defined.
If Left(Link, 1) "'" Then
Exit Function
End If

' Remove the leading single quote
Link = Mid(Link, 2, Len(Link) - 1)

' the Directory name will end at the last occurrence of ""
' find last occurrence of ""
iChrPos = InStrRev(Link, "")
Directory = Left(Link, iChrPos)
Link = Mid(Link, iChrPos + 1, Len(Link) - iChrPos)

' The next character will be a "[" unless the worksheet name has not been defined (and a workbook-level named range is
being used)
If Left(Link, 1) = "[" Then

' a worksheet is defined, the Workbook name will be until "]"
iChrPos = InStr(Link, "]")
WorkbookName = Mid(Link, 2, iChrPos - 2)
Link = Mid(Link, iChrPos + 1, Len(Link) - iChrPos)

' the worksheet name will be until a single quote
iChrPos = InStr(Link, "'")
WorksheetName = Mid(Link, 1, iChrPos - 1)
Link = Mid(Link, iChrPos + 2, Len(Link) - iChrPos)

Else

' a worksheet is not defined
WorksheetName = ""

' the workbook name will be until a single quote
iChrPos = InStr(Link, "'")
WorkbookName = Mid(Link, 1, iChrPos - 1)
Link = Mid(Link, iChrPos + 2, Len(Link) - iChrPos)

End If

' the WorksheetRange will be what is left over in the Link string
WorksheetRange = Link

' Create a new Excel instance
Set xlapp = CreateObject("Excel.Application")

' Open the linked workbook as read-only and do not update any links in the linked workbook.
' If the workbook doesn't exist, an error will be triggered.
Set xlwb = xlapp.Workbooks.Open(Directory & WorkbookName, UpdateLinks:=False, ReadOnly:=True)

' If a workbook-level name has been used (i.e. no WorksheetName was specified), then we need to refer
' to the RefersTo property of the named range to ascertain the proper worksheet.
If WorksheetName = "" Then

' temporarily add a blank worksheet to avoid problems with worksheet-level named ranges
Set xlws = xlwb.Worksheets.Add

NamedRangeRefersTo = xlwb.Names(WorksheetRange).RefersTo
' find the '!' in the range
iChrPos = InStr(1, NamedRangeRefersTo, "!")
WorksheetName = Mid(NamedRangeRefersTo, 2, iChrPos - 2)

'check for single quotes around WorksheetName
If Left(WorksheetName, 1) = "'" Then
WorksheetName = Mid(WorksheetName, 2, Len(WorksheetName) - 2)
End If
End If

' Refer to the WorksheetName worksheet.
' If the worksheet doesn't exist, an error will be triggered.
Set xlws = xlwb.Worksheets(WorksheetName)

' Refer to the WorksheetRange range on the worksheet.
' If the range doesn't exist or is invalid, an error will be triggered.
Set r = xlws.Range(WorksheetRange)

LINKEDRANGE = r

End If

CleanUp:
Set xlws = Nothing
If Not xlwb Is Nothing Then xlwb.Close 0
Set xlwb = Nothing
If Not xlapp Is Nothing Then xlapp.Quit
Set xlapp = Nothing

End Function

'-------------------------------------------------
'-------------------------------------------------

' In order to assist with building the 'Link' parameter above (or 'xref' for PULL),
' I created another little UDF below that returns the Link parameter based on
' directory, workbook, worksheet and range inputs.

'-------------------------------------------------
'-------------------------------------------------

Function LINKREFERENCE(Directory As String, WorkbookName As String, WorksheetName As String, WorksheetRange As String) As
String

' This function can used as a helper for the LINKEDRANGE function. This function takes in information about the linked range
' and returns a link reference in the form needed by LINKEDRANGE.

' Function Inputs:
'
' Directory - the full path that contains the workbook from which values will be pulled
' - trailing "" is optional
' - e.g. C:LinkedData
' - relative directories can be used
' - e.g. "C:DummyDirectory..LinkedData" (evaluates to C:LinkedData)
'
' WorkbookName - the name of the workbook from which values will be pulled
' - e.g. LinkedWorkbook.xls
'
' WorksheetName - optional - leave blank if referring to a workbook-level named range
' - the name of the worksheet from which values will be pulled
' - e.g. LinkedSheet
'
' WorksheetRange - the cell range or named range from which values will be pulled
' - e.g. A1:E5
' - e.g. $A$1:$E$5
' - e.g. LinkedNamedRange

' Function Output:
' LINKEDRANGE - a string that contains the link reference in the form used by LINKEDRANGE

Dim sLinkReference As String

On Error GoTo CleanUp

' If the Directory, WorkbookName or WorksheetRange fields are not defined, then exit the function immediately.
If IsEmpty(Directory) Or IsEmpty(WorkbookName) Or IsEmpty(WorksheetRange) Then
Exit Function
End If

' Trim the inputs of any excess spaces
Directory = Trim(Directory)
WorkbookName = Trim(WorkbookName)
WorksheetName = Trim(WorksheetName)
WorksheetRange = Trim(WorksheetRange)

' check the Directory string and append a '' to its end if it doesn't already have one
If Right(Directory, 1) "" Then
Directory = Directory & ""
End If

' prefix with a single quote
sLinkReference = "'" & Directory ' e.g. 'C:LinkedData

' A worksheet does not need to be specified if using a workbook-level name.
' The format of the 'xref' statement to be evaluated differs if the workbook is not defined.
' Add a "[" if the worksheet name is defined.
If WorksheetName "" Then
sLinkReference = sLinkReference & "[" ' e.g. 'C:LinkedData[
End If

' Add the workbook name
sLinkReference = sLinkReference & WorkbookName ' e.g. 'C:LinkedData[LinkedWorkbook.xls

' Add a "]" if the worksheet name is defined
If WorksheetName "" Then
sLinkReference = sLinkReference & "]" ' e.g. 'C:LinkedData[LinkedWorkbook.xls]
End If

' Add the worksheet name (may be blank)
sLinkReference = sLinkReference & WorksheetName ' e.g. 'C:LinkedData[LinkedWorkbook.xls]LinkedSheet

' Add a single quote and exclamation point
sLinkReference = sLinkReference & "'!" ' e.g. 'C:LinkedData[LinkedWorkbook.xls]LinkedSheet'!

' Add the linked range (cell range or named range)
sLinkReference = sLinkReference & WorksheetRange ' e.g. 'C:LinkedData[LinkedWorkbook.xls]LinkedSheet'!A1:E5

LINKREFERENCE = sLinkReference

CleanUp:

End Function

'-------------------------------------------------
'-------------------------------------------------

' Finally, here's a small UDF to return the current workbook directory, which can be helpful
' for creating relative links. This is preferable to using the CELL("filename", A1) function
' since CELL("filename") is volatile (even though Microsoft claims it is not!)

'-------------------------------------------------
'-------------------------------------------------

Function ThisWorkbookDirectory() As String
' This function returns the directory of this workbook.

Dim sFullName As String
Dim iChrPos As Integer, iStrPos As Integer

sFullName = ThisWorkbook.FullName

' find last occurrence of ""
iChrPos = InStrRev(sFullName, "")
ThisWorkbookDirectory = Left(sFullName, iChrPos)

End Function

-------------------------------------------------

I hope that someone finds this helpful!

Thanks,
Shawn Stackhouse

--
----------------------------------------------
Posted with NewsLeecher v3.0 Final
* Binary Usenet Leeching Made Easy
* http://www.newsleecher.com/?usenet
----------------------------------------------

I have a workbook that that is attached in the link below. It has several sheets in it. One is laid out with all the "master" data and the others are fed to it through a criteria page. I need to pull in "Due Dates" Based on I have now put the due dates in the sheet named master template.

I need to find a statement that can match Cell B5 from the criteria sheet, to pull in the correct column (60 Days Due Date = 60, 90 Days Due Date if = 90, and 120 Days Due Date if = 120) into the column "Due Date" on the internal project plan tab.

There is a macro that pulls in the data from the master template to the internal plan, but I do not know how to change it. It is below:

I appreciate any assistance you can provide. Thanks

I posted this on Excel Forum, but have not gotten a response, so I have posted it here as well.
http://www.excelforum.com/showthread.php?t=649333

Code:
 
Private Sub CommandButton1_Click()
  Dim OutSH As Worksheet, TemplateSH As Worksheet, ce As Variant
  Dim DataCol As Integer, OutRow As Long, i As Long
  Dim arr As Variant
  Set OutSH = Sheets("Internal Project Plan")
  Set TemplateSH = Sheets("Master Template")
  
  For Each ce In Range("B15:B80")
    If ce = "Yes" Then
      DataCol = WorksheetFunction.Match(ce.Offset(0, -1).Value, TemplateSH.Rows("1:1"), 0)
      With TemplateSH
        For i = 2 To 700
          If .Cells(i, DataCol).Value = "x" Then
          'check to see if it already exists and only proceed if it does not
            If WorksheetFunction.CountIf(OutSH.Range("A:A"), TemplateSH.Cells(i, 1).Value) = 0 Then
              OutRow = OutSH.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
              OutSH.Cells(OutRow, 1).Value = .Cells(i, 1).Value
              OutSH.Cells(OutRow, 2).Value = .Cells(i, 4).Value
              OutSH.Cells(OutRow, 3).Value = .Cells(i, 16).Value
              OutSH.Cells(OutRow, 4).Value = .Cells(i, 5).Value
              OutSH.Cells(OutRow, 9).Value = .Cells(i, 69).Value
            End If
          End If
        Next i
      End With
    End If
  Next ce
  Application.StatusBar = "Transferring Headings"
  arr = Array(2, 15, 77, 87, 461, 507, 534, 553, 582)
  With TemplateSH
    For i = LBound(arr) To UBound(arr)
      OutRow = OutSH.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
      .Cells(arr(i), 1).Copy Destination:=OutSH.Cells(OutRow, 1)
      OutSH.Cells(OutRow, 1).Value = .Cells(arr(i), 1).Value
      .Cells(arr(i), 4).Copy Destination:=OutSH.Cells(OutRow, 2)
      OutSH.Cells(OutRow, 2).Value = .Cells(arr(i), 4).Value
      .Cells(arr(i), 10).Copy Destination:=OutSH.Cells(OutRow, 3)
      OutSH.Cells(OutRow, 3).Value = .Cells(arr(i), 10).Value
      .Cells(arr(i), 5).Copy Destination:=OutSH.Cells(OutRow, 4)
      OutSH.Cells(OutRow, 4).Value = .Cells(arr(i), 5).Value
      .Cells(arr(i), 69).Copy Destination:=OutSH.Cells(OutRow, 9)
      OutSH.Cells(OutRow, 9).Value = .Cells(arr(i), 69).Value
    Next i
  End With
  'sort output data
  Application.StatusBar = "Sorting Output"
  With OutSH
    .Range("A6:J" & .Cells(Rows.Count, 1).End(xlUp).Row).Sort key1:=.Range("A6"), order1:=xlAscending, header:=xlYes
   
  End With
    Application.StatusBar = False
   
With ActiveSheet
    For i = 7 To Range("B" & Rows.Count).End(xlUp).Row
        .Range("E" & i & ":I" & i).Interior.ColorIndex = .Range("B" & i).Interior.ColorIndex
    Next i
End With
Call Colors
Call Module6.SaveAs
End Sub


I'm having trouble getting cell formulas to update when they reference
a saved workbook.
The situation I have has one workbook for each of 3 brands of hardwood
floors, and a fourth workbook listing trim and molding pieces to go
with those floors. The structure of the workbooks looks something like;

G:
...Sales Admin
|
|-BRAND 1
| |-Brand1.xls
|
|-BRAND 2
| |-Brand2.xls
|
|-BRAND 3
| |-Brand3.xls
|
|-WOOd TRIM
| |-Trim.xls
|

In each of the Brand spreadsheets there is a listing of floor products,
and a column in those products that lists the product code of the
particular piece of trim that is recomended for that floor. In the Trim
spreadsheet there is a list of trim products with about 1900 entries,
each with a unique product code in the first column. In the Trim
spreadsheet there are three columns that are supposed to check to see
which brand of floors that piece of trim is used with. The column looks
in one of the brand workbooks and checks the column of recomended trim.
If it finds the product code for that row then it puts an 'X'
indicating a match. The point of this is that each piece of trim isn't
brand specific, and can apear on one, multiple, or no floor worksheets.
Our users want to be able to sort and filter the trim table by these
brand columns to only get the products associated with the floors they
use.

The formula to preform this lookup looks like this;

=IF(COUNTIF('G:...Sales AdminBRAND
1[Brand1.xls]Finished'!$L:$L,A3)>0,"X","")

'Finished' is the sheet name these floors are on, '$L' is the column in
that spreadsheet where the recomended trim is, and A3 is the cell for
this row that has the product code. If the product code appears one or
more times in column L of the floor table, count will be greater than
zero and the statement will print an X, ortherwise the cell will be
blank. There is a similar function for each of the three columns, and
this function fills down through all of the rows of the trim table.

The problem I'm having is that the function will only update if the
Brand spreadsheet is open. When I try to update the table with the
brand spreadsheets closed I get a #VALUE! 'A value used in the formula
is of the wrong data type' error for all of the lookups. Using the
Evaluate Formula tool the error seems to come from the CountIf call.
After that step #VALUE! is returned and used for the rest of the
evaluation. If I open up one of the Brand spreadsheets then the cells
in that column will automatically update themselves and replace the
#VALUE! error. The only way I can get the columns to update is to open
all three spreadsheets. I haven't had this kind of problem in the past
when trying to create links from one spreadsheet to another. The
problem might be just with the size of the tables. Originally this
update took 8 minutes to complete, and now with a more effective search
is down to 1 minute. I need to get this table to update automatically
without having to open all of the tables it pulls from. I haven't been
able to find a solution to this and would appreciate any assitance.

Paul Zipko

Hi!

I'll explain to you my problem:

I have an excel spreadsheet with 4 different tabs.

the first tab needs to have the dropdown for the user to select a database.

the second and third tabs are pivot tables created in vba

the fourth tab are the columns that run the pivot tables.

Now I have a stored proc in SQL Server 2000 that has an input parameter called 'Matter'. Once the user selects the database...that database needs to be fed into the stored proc to run it only against that particular database and then the results should come back to the first tab.

The code I have in my spreadsheet for the form is as follows:


	VB:
	
 
 
Const stCon    As String = "Provider=SQLOLEDB;" & _ 
"DATA SOURCE=dr-ny-sql001; INITIAL CATALOG=master;" & _ 
"INTEGRATED SECURITY=sspi;" 
 
 
Private Sub cmdClose_Click() 
     'close the form
    Unload Me 
End Sub 
 
Private Sub chkmat_Click() 
     'This is where you can add a  filter by the year
    Dim stSQL  As String 
    Dim cnt    As ADODB.Connection 
    Dim rst    As ADODB.Recordset 
    Dim vaData As Variant 
     
     'Just select the Distinct databases from sysdatabases Table to load into matter  Combobox
    stSQL = "SELECT distinct  name  FROM sysdatabases where name like 'client%';" 
     
    If chkmat.Value = True Then 
         'if the year filter checkbox is checked
        Set cnt = New ADODB.Connection 
        Set rst = New ADODB.Recordset 
        cnt.ConnectionString = stCon 
        With cnt 
            .CursorLocation = adUseClient 'Necesary for creating disconnected recordset.
            .Open stCon 'Open connection.
             'Execute the SQL statement.
            Set rst = .Execute(stSQL) 
        End With 
        With rst 
            Set .ActiveConnection = Nothing 'Disconnect the recordset.
             'Populate the array with the whole recordset.
            vaData = .GetRows 
        End With 
         'Close the connection.
        cnt.Close 
        With Me 
            With .cmbmat 
                .Clear 
                 'load the query result into combobox
                .List = Application.Transpose(vaData) 
                .ListIndex = -1 
            End With 
        End With 
    Else 
        With Me 
            With .cmbmat 
                .Clear 
            End With 
        End With 
    End If 
End Sub 
 
Private Sub cmdQuery_Click() 
     'run query to find records
    Dim stParam As String, stParam2 As String 
    Dim stSQL  As String 
    Dim cnt    As ADODB.Connection 
    Dim rst    As ADODB.Recordset 
    Dim fld    As ADODB.Field 
    Dim wsSheet As  Worksheet, wbBook As Workbook 
    Dim i As Long, j As Long, x As Integer 
     
     'initial SQL to return all records
    stSQL = "SELECT * FROM sysdatabases" 
     
     'set the parameter strings
    stParam = " WHERE Name = " & Me.cmbmat.Text 
    stParam2 = " ;" 
     
     'check & build  variable parameters
     'depending on whether checkbox ticked by user
    If Me.chkmat.Value = True Then 
        stSQL = stSQL & stParam & stParam2 
    Else: stSQL = stSQL & stParam2 
    End If 
     
    On  Error Goto ErrHandle 
     
    Set cnt = New ADODB.Connection 
    Set rst = New ADODB.Recordset 
     
    Set wbBook = ThisWorkbook 
    Set wsSheet = ThisWorkbook.Worksheets(1) 
     
    With cnt 
        .ConnectionString = stCon 
        .Open 
    End With 
     
    With rst 
        .CursorLocation = adUseClient 
        .Open stSQL, cnt, adOpenStatic, adLockReadOnly 
        .ActiveConnection = Nothing 'Here we disconnect the recordset.
        j = .Fields.Count 
        i = .RecordCount 
    End With 
     
    With wsSheet 
        .UsedRange.Clear 
        If i = 0 Then Goto i_Err 
         'Write the fieldnames to the fifth row in the worksheet
        For x = 0 To j - 1 
            .Cells(5, x + 1).Value = rst.Fields(x).Name 
        Next x 
         'Dump the data to the worksheet.
        .Cells(6, 1).CopyFromRecordset rst 
    End With 
     
    If CBool(rst.State And adStateOpen) = True Then rst.Close 
    Set rst = Nothing 
    If CBool(cnt.State And adStateOpen) = True Then cnt.Close 
    Set cnt = Nothing 
     
ExitHere: 
    Exit Sub 
     
ErrHandle: 
    Dim cnErrors As ADODB.Errors 
    Dim ErrorItem As ADODB.Error 
    Dim stError As String 
     
    Set cnErrors = cnt.Errors 
     
    With Err 
        stError = stError & vbCrLf & "VBA Error # : " & CStr(.Number) 
        stError = stError & vbCrLf & "Generated by : " & .Source 
        stError = stError & vbCrLf & "Description : " & .Description 
    End With 
     
    For Each ErrorItem In cnErrors 
        With ErrorItem 
            stError = stError & vbCrLf & "ADO error # : " & CStr(.Number) 
            stError = stError & vbCrLf & "Description : " & .Description 
            stError = stError & vbCrLf & "Source : " & .Source 
            stError = stError & vbCrLf & "SQL State : " & .SqlState 
        End With 
    Next ErrorItem 
    MsgBox stError, vbCritical, "SystemError" 
    Resume ExitHere 
     
i_Err: 
    MsgBox "There are no records for this Query" 
    Goto ExitHere 
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines

the code I have for the first tab is as follows:


	VB:
	
 
Sub Preview_Report() 
     
    Dim cn As ADODB.Connection 
    Dim cmd As ADODB.Command 
    Dim rs As ADODB.Recordset 
    Dim strConn As String 
     
    Set cn = New ADODB.Connection 
     
    Dim strServer As String, strDatabase As String 
     
    strServer = "dr-ny-sql001" 
    strDatabase = "master" 
     
     'Use the SQL Server ODBC Provider.
     
     'strConn = "Driver={SQL Server};Server=" & strServer & ";Database=" & strDatabase & ";Uid=" & strUser & ";Pwd=" &
strPassword & ";"
     
     'Use the SQL Server OLE DB Provider.
     'strConn = "Provider=SQLOLEDB;Data Source=" & strServer & ";Initial Catalog=" & strDatabase & ";User Id=" & strUser &
";Password=" & strPassword & ";"
    strConn = "PROVIDER=SQLOLEDB;" 
     
     'Connect to the Pubs database on the local server.
    strConn = strConn & "DATA SOURCE=" & strServer & ";INITIAL CATALOG=" & strDatabase & ";" 
     
     'Use an integrated login.
    strConn = strConn & " INTEGRATED SECURITY=sspi;" 
     
     'Now open the connection.
    cn.Open strConn 
     
    Range("A15:AZ500").ClearContents 
     
    Set cmd = New ADODB.Command 
    cmd.ActiveConnection = cn 
    cmd.CommandText = "master.dbo.usp_DR_Preview_test" 'Name of stored procedure
     
    With cmd 
        .Parameters.Refresh 
        .Parameters.Append .CreateParameter("Client_Lehman_ASARCO", adVarChar, adParamInput, 100, Range("D2")) ' Character
value of no more than 255 bytes
         ' Other possible parameter types
         '.Parameters.Append .CreateParameter("QueryTextParam", adVarChar, adParamInput, 10, "Value")
         '.Parameters.Append .CreateParameter("QueryLongParam", adBigInt, adParamInput, , LongValue)
         '.Parameters.Append .CreateParameter("QueryDateParam", adDate, adParamInput, , DateValue)
         '.Parameters.Append .CreateParameter("QueryDateTimeStampParam", adDBTimeStamp, adParamInput, , DateTimeValue)
         '.Parameters.Append .CreateParameter("BooleanParam", adBoolean, adParamInput, , BooleanValue)
    End With 
     
    cmd.CommandType = adCmdStoredProc 
     
    Set rs = New ADODB.Recordset 
     
     
     'With rs
     '.Source = "SET NOCOUNT ON"
     '.ActiveConnection = cn
     '.Open
     'End With
     
    Set rs = cmd.Execute() 
     
     'If Not rs.EOF Then
    Worksheets("Sheet1").Range("A15").CopyFromRecordset rs 
     'Else
     'MsgBox "No data returned from stored procedure: '" & "usp_DR_Preview_test" & "' using parameter value: " & Range("D2")
     'End If
     
    rs.Close 
    cn.Close 
     
    Set rs = Nothing 
    Set cn = Nothing 
     
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines

this code does not work. it does not run the stored proc...it only created the temp tables.

In the fourth tab i am running the code off another stored procedure.

Is there any way to achieve this?????

I am pulling my hair out already!!!

Thanks a lot for your help!

Tammy

Hello,

Another question for the brain boxes of the forum.

I have an XLS spreadsheet which updates cells through an ODBC connection to a database. The information is pulled across ok and 90% of the Vlookup and IF statements work.

The problem arises on a summary page.

When i start off the summary page has cell references in numeric order to another spreadsheet and pulls back the information to 4 cells Across and 1000 Down.

='Campaign Responses - Cash Break'!A2

This is a spreadsheet that changes once the queries have run and a number between 1-1000 records are returned.

However once the data has changed and the page refreshed. Not all the results have been pulled across to the summary pages. A few are there but the numeric sequence jumps from

='Campaign Responses - Cash Break'!A20

to

='Campaign Responses - Cash Break'!A802

Therefore missing out pulling back the records between row 80 and 802.
Sometimes there is also a problem with the cell displaying #ref. However when i copy the formula from the top line of cells and paste it the cell values update.

Anyone have any idea why this might be?

Thanks

Hi, I have a macro that formats data exported from a database that I can then copy and paste into another spreadsheet which pulls the raw data into a pivot table.

The problem:
I keep having to edit the rows in the Macro to delete as the data is different from week to week. I either need to be able to prompt for the row to edit, or preferrably, have an conditional statement that looks for a text value in column A (like "DUDE") and deletes all rows, incuding that one, and below....THEN same code again but this time looking for a different value in column A (like"SWEET") and deleting all rows, including that one, up through row 11.

So lets say the data was 5000 rows with a header column on row 10. I want to delete all rows DUDE - 5000 and then all rows 11 - SWEET, but I would like the macro to look for those words to base the end/start points of the row deletes.

Here is the code I have so far. There is some other formatting in there as well, like deleting extra sheets. ALSO: is there a way to stop excel from prompting on asking me if I was to delete a sheet when it is in the Macro to do so?

Sub Weekly_Usage()
'
' Weekly_Usage Macro
'
'
    Rows("1:6").Select
    Sheets("KMA Charts").Select
    ActiveWindow.SelectedSheets.Delete
    Sheets("Company Summary").Select
    ActiveWindow.SelectedSheets.Delete
    Sheets("Dept Level Summary").Select
    ActiveWindow.SelectedSheets.Delete
    Sheets("Company Details").Select
    ActiveWindow.SelectedSheets.Delete
    Rows("4997:6000").Select 'Change LOWER number to same row as "DUDE"
    Selection.Delete Shift:=xlUp
    Rows("11:4585").Select 'Change HIGHER number to same row as "SWEET"
    Selection.Delete Shift:=xlUp
    Rows("1:9").Select
    Selection.Delete Shift:=xlUp
    Columns("A:C").Select
    Selection.Delete Shift:=xlToLeft
    Cells.Select
    Selection.RemoveSubtotal
    Columns("A:M").Select
    Selection.UnMerge
    Columns("H").Select
    Selection.Delete Shift:=xlToLeft
    Columns("F").Select
    Selection.Delete Shift:=xlToLeft
    Columns("C").Select
    Selection.Delete Shift:=xlToLeft
    Columns("A:M").EntireColumn.AutoFit
    Range("F2").Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Tech Level Details").AutoFilter.Sort.SortFields. _
        Clear
    ActiveWorkbook.Worksheets("Tech Level Details").AutoFilter.Sort.SortFields.Add _
        Key:=Range("F1:F815"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Tech Level Details").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Columns("F:F").Select
    Selection.TextToColumns Destination:=Range("F1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    Selection.NumberFormat = "0000"
    Range("F2").Select
    Selection.End(xlDown).Select
    
End Sub


Here is the solution, nothing was populated in column I so the data kept resetting the row to update as 2. I changed the column to where updates were always present and it worked like a charm. Thank you for your assistance. I am attaching the working code incase anyone needs it.

Private Sub CommandButton6_Click()

Worksheets("Proposals").Range("A3:S65536").ClearContents

'---------This Section populates the 'Proposals' tab
Set rd = Sheets("Presentations") 'set read data sheet as rd
Set wd = Sheets("Proposals") 'set write data sheet as wd

    For i = 103 To rd.Range("S65536").End(xlUp).Row ' set i to the last row in column S
   
         If LCase(rd.Cells(i, 10).Value) Like "*proposal*" Then
          wd.Cells(wd.Range("C65536").End(xlUp).Row + 1, 3) = rd.Cells(i, 10)
          wd.Cells(wd.Range("C65536").End(xlUp).Row, 1) = rd.Cells(i, 4)
          wd.Cells(wd.Range("C65536").End(xlUp).Row, 2) = rd.Cells(i, 6)
          wd.Cells(wd.Range("C65536").End(xlUp).Row, 4) = rd.Cells(i, 11)
          wd.Cells(wd.Range("C65536").End(xlUp).Row, 5) = rd.Cells(i, 15)
          wd.Cells(wd.Range("C65536").End(xlUp).Row, 6) = rd.Cells(i, 16)
          wd.Cells(wd.Range("C65536").End(xlUp).Row, 7) = rd.Cells(i, 17)
          wd.Cells(wd.Range("C65536").End(xlUp).Row, 8) = rd.Cells(i, 18)
          End If
     
     Next i
Hello Everybody,

Hope all is well. I have written the following code. It takes data from one worksheet and imputs it into another. What this is suppose to do is take the data (Rows 103 to 65536) from the Presentations worksheet and put them into a smaller spreadsheet starting on row 3. For each successful if statement, the return should be on its own row.

I have this so it searches for the first empty row then inputs the data on the proposals workbook. The problem I am running into is that the first line is that this data:

is placing the data in the correct spot (Row 3), but all subsequent sucessful if statements are re writing on the same line. 
How and where do I add one to the row.  

***This is a sample of one workbook. I am pulling off of 5 worksheets within the same excel file. The code all the same repeated 5 times. So when one is done then I will need the row to keep going for the next set of information. I feel that I can add this easy enough, I just want to identify it in case there is an issue you may forsee.

Here is the repeated code.

Private Sub CommandButton6_Click()

Worksheets("Proposals").Range("A3:S65536").ClearContents
TheDate = Date

'---------This Section populates the 'Proposals' tab
Set rd = Sheets("Presentations") 'set read data sheet as rd
Set wd = Sheets("Proposals") 'set write data sheet as wd
     
    For i = 103 To rd.Range("S65536").End(xlUp).Row ' set i to the last row in column S
        If rd.Cells(i, 10).Value Like "*proposal*" Then
          wd.Cells(wd.Range("I65536").End(xlUp).Row + 1, 3) = rd.Cells(i, 10)
          wd.Cells(wd.Range("I65536").End(xlUp).Row + 1, 1) = rd.Cells(i, 4)
          wd.Cells(wd.Range("I65536").End(xlUp).Row + 1, 2) = rd.Cells(i, 6)
          wd.Cells(wd.Range("I65536").End(xlUp).Row + 1, 4) = rd.Cells(i, 11)
          wd.Cells(wd.Range("I65536").End(xlUp).Row + 1, 5) = rd.Cells(i, 15)
          wd.Cells(wd.Range("I65536").End(xlUp).Row + 1, 6) = rd.Cells(i, 16)
          wd.Cells(wd.Range("I65536").End(xlUp).Row + 1, 7) = rd.Cells(i, 17)
          wd.Cells(wd.Range("I65536").End(xlUp).Row + 1, 8) = rd.Cells(i, 18)
        End If
    Next i
Any and all help is appreciated. I would like to send a thank you out to all that have been so gracious and kind with their time already, helping me learn my way around VBA.

Regards,
jsgray