need help

A

amjadfarhan

I am using this calling function to populate the companies data in
subform but its not showing the data with "-NZ" company's data. Whats
wrong withit.

calling function is:
fncExcel2AccessPM "Annual Data", "PMAnnual", "Annual", 7, 3, 2,
Me.Check125.Value

**** check125 holds the NZ data (true or False) in this case its
checked
**** when i increase the no. of Years from 2 to 3 or 4 or 5. it gives
me the error "column NAME not found"

Function fncExcel2AccessPM(sSheet As String, sTable As String,
sTimeFrame As String, lStartDatasetColumn As Long,
lNumberofDatasetColumns As Long, lNumberOfYears As Long, bNzComp As
Boolean)
Dim sStartYear As String
Dim sEndYear As String
Dim sCell As String
Dim lCodeColumn As Long
Dim lStartDateColumn As Long
Dim lEndDateColumn As Long
Dim lStartCompanyRow As Long
Dim lEndCompanyRow As Long
Dim mc As Object
Dim sStartRange As String
Dim sEndRange As String
Dim cn As New ADODB.Connection
Dim rectable As New ADODB.Recordset
Dim sFileName As String
Dim strFilter As String
Dim lMNEMRow As Long
Dim lNameColumn As Long
Dim retval As Long
Dim sINIPathName As String
Dim strPath As String
Dim lPMYearID As Long
Dim sSQL As String
Dim lNoYear As Long
Dim lYearOffset As Long

Dim Y As Long
Dim x As Long


'Include References Microsoft Excel 8.0 Object Library

Dim oExcel As Object


'Dim sSheet As String

'Excel Sheet Name
'sSheet = "Annual Data"
'Table in Database
'sTable = "PMAnnual"
'Suffix in sTable
'sTimeFrame = "Annual" 'sTimeFrame = "3_Yr"
'lStartDatasetColumn = 7
'lNumberofDatasetColumns = 3 'Name, 1st year, 2nd year

'lNumberOfYears = 2 '2000, 2001


If bNzComp Then

If MsgBox("Are you sure that you would like to import data for New
Zealand companies?", vbYesNo + vbDefaultButton2) = vbNo Then
Exit Function
End If
Else

If MsgBox("Are you sure that you would like to import data for
Australian companies?", vbYesNo + vbDefaultButton2) = vbNo Then
Exit Function
End If

End If


Set oExcel = CreateObject("Excel.Application")

strFilter = fncAddFilterItem(strFilter, "Excel Files (*.xls, *.xls)")
sFileName = fncCommonFileOpenSave(InitialDir:="", FileName:="",
Filter:=strFilter, Flags:=0, DialogTitle:="Open Performance Measures",
OpenFile:=True)

If sFileName <> "" Then

oExcel.Workbooks.Open FileName:=sFileName

oExcel.Visible = False


On Error Resume Next

Debug.Print oExcel.Worksheets(sSheet).Cells(1, 1).Value
If Err = 9 Then
MsgBox "This Excel file doesn't contain the sheet: " & sSheet
oExcel.DisplayAlerts = False
oExcel.Quit
oExcel.DisplayAlerts = True
Set oExcel = Nothing
Exit Function
End If

On Error GoTo 0

DoCmd.Hourglass True
DoEvents


lStartCompanyRow = 2
lMNEMRow = 4

x = lStartCompanyRow
Do
x = x + 1
sCell = oExcel.Worksheets(sSheet).Cells(x, lMNEMRow).Value
Loop Until sCell = "" Or x = 25000
lEndCompanyRow = x - 1

If x >= 25000 Then
MsgBox "Error in Excel sheet or more than 25'000 companies!"
DoCmd.Hourglass False
Exit Function
End If


For lNoYear = 0 To lNumberOfYears - 1

sStartYear = oExcel.Worksheets(sSheet).Cells(2,
lStartDatasetColumn + lNoYear).Value

cn.ConnectionString = fncGetConnectionString
cn.Open

sSQL = "SELECT Year, DateOfUpload, PMYearID FROM dbo.PMYear
WHERE (Year = " & sStartYear & ")"

rectable.Open sSQL, cn

If Not rectable.EOF Then
lPMYearID = rectable![PMYearID]
rectable.Close
cn.Close
'delete all company data
subExecuteStoredProc "DELETE FROM dbo." & sTable & " WHERE
(PMYearID = " & lPMYearID & ") "
Else
rectable.Close
cn.Close

'create new year
cn.ConnectionString = fncGetConnectionString
cn.Open

sSQL = "SELECT Year, DateOfUpload, PMYearID FROM
dbo.PMYear"

rectable.CursorType = adOpenKeyset
rectable.LockType = adLockOptimistic
rectable.Open sSQL, cn

rectable.AddNew
rectable!Year = sStartYear
rectable!DateOfUpload = Now
rectable.Update
rectable.Move 0
lPMYearID = rectable![PMYearID]

rectable.Close
cn.Close

End If


cn.ConnectionString = fncGetConnectionString
cn.Open

sSQL = "SELECT * FROM dbo." & sTable

rectable.CursorType = adOpenKeyset
rectable.LockType = adLockOptimistic

rectable.Open sTable, cn, , , adCmdTable

lYearOffset = lNoYear
retval = SysCmd(acSysCmdInitMeter, "Importing Excel Data...",
lEndCompanyRow)
For x = lStartCompanyRow + 1 To lEndCompanyRow

If Right(oExcel.Worksheets(sSheet).Cells(x,
lMNEMRow).Value, 1) = "X" Then

rectable.AddNew

If bNzComp Then
rectable![ASX Code] =
Mid(oExcel.Worksheets(sSheet).Cells(x, lMNEMRow).Value, InStr(1,
oExcel.Worksheets(sSheet).Cells(x, lMNEMRow).Value, ":") + 1, 3) &
"-NZ"
Else
rectable![ASX Code] =
Mid(oExcel.Worksheets(sSheet).Cells(x, lMNEMRow).Value, InStr(1,
oExcel.Worksheets(sSheet).Cells(x, lMNEMRow).Value, ":") + 1, 3)
End If

rectable![PMYearID] = lPMYearID

sCell = oExcel.Worksheets(sSheet).Cells(x,
lStartDatasetColumn + lYearOffset).Value
If InStr(1, sCell, "$") Or sCell = "" Then
rectable.Fields("EPS Growth" & "_" & sTimeFrame) =
Null
Else
rectable.Fields("EPS Growth" & "_" & sTimeFrame) =
sCell
End If
'10
sCell = oExcel.Worksheets(sSheet).Cells(x,
lStartDatasetColumn + (1 * lNumberofDatasetColumns) +
lYearOffset).Value
If InStr(1, sCell, "$") Or sCell = "" Then
rectable.Fields("NET Sales Growth" & "_" &
sTimeFrame) = Null
Else
rectable.Fields("NET Sales Growth" & "_" &
sTimeFrame) = sCell
End If

'13
sCell = oExcel.Worksheets(sSheet).Cells(x,
lStartDatasetColumn + (2 * lNumberofDatasetColumns) +
lYearOffset).Value
If InStr(1, sCell, "$") Or sCell = "" Then
rectable.Fields("Return on Invested Capital" & "_"
& sTimeFrame) = Null
Else
rectable.Fields("Return on Invested Capital" & "_"
& sTimeFrame) = sCell
End If

'16
sCell = oExcel.Worksheets(sSheet).Cells(x,
lStartDatasetColumn + (3 * lNumberofDatasetColumns) +
lYearOffset).Value
If InStr(1, sCell, "$") Or sCell = "" Then
rectable.Fields("Return on Equity" & "_" &
sTimeFrame) = Null
Else
rectable.Fields("Return on Equity" & "_" &
sTimeFrame) = sCell
End If

'19
sCell = oExcel.Worksheets(sSheet).Cells(x,
lStartDatasetColumn + (4 * lNumberofDatasetColumns) +
lYearOffset).Value
If InStr(1, sCell, "$") Or sCell = "" Then
rectable.Fields("Price/Earnings ratio" & "_" &
sTimeFrame) = Null
Else
rectable.Fields("Price/Earnings ratio" & "_" &
sTimeFrame) = sCell
End If
'22
sCell = oExcel.Worksheets(sSheet).Cells(x,
lStartDatasetColumn + (5 * lNumberofDatasetColumns) +
lYearOffset).Value
If InStr(1, sCell, "$") Or sCell = "" Then
rectable.Fields("Return on Assets ratio" & "_" &
sTimeFrame) = Null
Else
rectable.Fields("Return on Assets ratio" & "_" &
sTimeFrame) = sCell
End If
'28
sCell = oExcel.Worksheets(sSheet).Cells(x,
lStartDatasetColumn + (7 * lNumberofDatasetColumns) +
lYearOffset).Value
If InStr(1, sCell, "$") Or sCell = "" Then
rectable.Fields("Net Income Growth" & "_" &
sTimeFrame) = Null
Else
rectable.Fields("Net Income Growth" & "_" &
sTimeFrame) = sCell
End If
'25
sCell = oExcel.Worksheets(sSheet).Cells(x,
lStartDatasetColumn + (6 * lNumberofDatasetColumns) +
lYearOffset).Value
If InStr(1, sCell, "$") Or sCell = "" Then
rectable.Fields("Beta" & "_" & sTimeFrame) = Null
Else
rectable.Fields("Beta" & "_" & sTimeFrame) = sCell
End If
'31
sCell = oExcel.Worksheets(sSheet).Cells(x,
lStartDatasetColumn + (8 * lNumberofDatasetColumns) +
lYearOffset).Value
If InStr(1, sCell, "$") Or sCell = "" Then
rectable.Fields("TSR" & "_" & sTimeFrame) = Null
Else
rectable.Fields("TSR" & "_" & sTimeFrame) = sCell
End If
'34
sCell = oExcel.Worksheets(sSheet).Cells(x,
lStartDatasetColumn + (9 * lNumberofDatasetColumns) +
lYearOffset).Value
If InStr(1, sCell, "$") Or sCell = "" Then
rectable.Fields("EBIT Growth" & "_" & sTimeFrame) =
Null
Else
rectable.Fields("EBIT Growth" & "_" & sTimeFrame) =
sCell
End If
'37
sCell = oExcel.Worksheets(sSheet).Cells(x,
lStartDatasetColumn + (10 * lNumberofDatasetColumns) +
lYearOffset).Value
If InStr(1, sCell, "$") Or sCell = "" Then
rectable.Fields("Asset Turnover" & "_" &
sTimeFrame) = Null
Else
rectable.Fields("Asset Turnover" & "_" &
sTimeFrame) = sCell
End If
'40
sCell = oExcel.Worksheets(sSheet).Cells(x,
lStartDatasetColumn + (11 * lNumberofDatasetColumns) +
lYearOffset).Value
If InStr(1, sCell, "$") Or sCell = "" Then
rectable.Fields("Operating Margin" & "_" &
sTimeFrame) = Null
Else
rectable.Fields("Operating Margin" & "_" &
sTimeFrame) = sCell
End If


rectable.Update

End If
retval = SysCmd(acSysCmdUpdateMeter, x)
Next x

retval = SysCmd(acSysCmdRemoveMeter)
rectable.Close
cn.Close

Next lNoYear


oExcel.DisplayAlerts = False
oExcel.Quit
oExcel.DisplayAlerts = True

Set oExcel = Nothing

'assign company code to ASX code
subExecuteStoredProc "qryUpdatePMCompanyCode '" & "dbo." & sTable &
"'"

DoCmd.Hourglass False

End If

End Function
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

VBA code help 3
A little help needed please... 7
VBA Coding Help for Beginner 0
Help needed! Extracting Heading 3 and Contents from a Word Doc to Excel 0
Adding a macro to copy worksheets 0
type mismatch error in macro in excel 0
Crrection Help for a macro to locate max value cell 2
For Eachcell in Range tranpose comma seperated values to a list in D 4

Top