LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 25
Default Follow up to array question

Here is my complete code. I have fixed some things with some help from people
at work. I click to run it and the error is "type mismatch". Again, any help
would be greatly appreciated. Thanks




Option Explicit

Private mcnToDatabase As Connection
Private mwksResults As Excel.Worksheet

Private Const STATE_FIPS_COL = 0
Private Const COMMODITY_COLUMN = 1
Private Const PRACTICE_COL = 2



Private Const CS = "Provider=Microsoft.Jet.OLEDB.4.0;User
ID=Admin;Mode=Share Deny None;Jet OLEDB:Engine Type=4;Data Source="

Private Const CLIENT_TAB = "CLIENT"
Private Const ALT_TAB = "ALT1"

Public Sub Run(dbPath As String)
Dim lDataRow As Long
Dim lData As String
Dim GetAllData As Variant
Dim asData() As Long
ReDim asData(1, 3)




ConnectToDatabase dbPath

GetAllData = asData()

'Stuff in Main that opens Excel



For lDataRow = 0 To UBound(asData)
Main dbPath, asData(lDataRow, STATE_FIPS_COL), asData(lData,
COMMODITY_COLUMN), asData(lData, PRACTICE_COL)

'RunSolver
'Save as new workbook
Next lDataRow

End Sub

Private Sub ConnectToDatabase(dbPath As String)
'mcn = GetConnection
End Sub

Private Sub WriteToExcel(lExcelRow As Long, sStateFips As String, sCommodity
As String, sPracticeCode As String, wks As Excel.Worksheet)
'Get to correct Excel sheet
'Row = lExcelRow, Column = 1
'Set Cell value = sStateFIPs

'Row = lExcelRow, Column = 2
'Set Cell value = sCommodity

'Row = lExcelRow, Column = 3
'Set Cell value = sPracticeCode
End Sub

Private Function GetAllData() As String()
'Gets array of unique state FIPS codes
'Recordset = query of distinct state fips codes
End Function

Sub Main(dbPath As String, istate As Long, icommodity As Long, ipractice As
Long)

Dim ClientTab As String, AltTab As String, calc
Dim lngTemp As Long, strTemp As String

With application
.DisplayAlerts = False
.ScreenUpdating = False
calc = .Calculation
.Calculation = xlCalculationManual
End With

ClientTab = "CLIENT"
AltTab = "ALT1"

application.StatusBar = "Retrieving recordset from CDB..."
GetTable dbPath, istate, icommodity
GetTableState dbPath, istate, icommodity, ipractice
GetTableCounty dbPath, istate, icommodity, ipractice
'
'strTemp = Right(Left(ClientFiles, Len(ClientFiles) - 4), 2)
'With ThisWorkbook.Sheets("ExhibitA")
' .Activate
' strTemp = Application.WorksheetFunction.VLookup(Val(strTemp) , _
' .Range("StateLookup"), 3, False)
' .Range("SubTitle") = "ACReS Retroactive Comparison - " & strTemp
'End With

Calculate
With application
.StatusBar = "Done."
.Calculation = calc
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub

Private Sub GetTable(dbPath As String, istate As Integer, icommodity As Long)
'Chris

Dim cn As New Connection, rs As Recordset, rngTemp As Range
Dim fff As Range


Sheets("WeatherLookup_input").Select
Range("A2:AE2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents

Sheets("CrossProduct").Select
Range("A2:AE2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents

Sheets("StateYield_input").Select
Range("A2:G2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents

Sheets("CountyYield").Select
Range("A10:AJ10").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents


Set rngTemp =
ThisWorkbook.Sheets("WeatherLookup_input").Range(" weatherdatastart")
'TODO: Fix to mcn
cn.ConnectionString = CS & dbPath
cn.Open
Set rs = cn.Execute("Select [Year]*10+[DivNo],
[HistoricalDiv_Weather_1895-2003].*, 1, 1 from
[HistoricalDiv_Weather_1895-2003] where Year = 1970 and fp =" & istate)

rngTemp.CopyFromRecordset rs
rngTemp.CurrentRegion.Name = "weatherdatarange"

Sheets("WeatherLookup").Select
Range("A2:AE2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Sheets("CrossProduct").Select
Range("A2").Select
ActiveSheet.Paste

Range("F2").Select
'ActiveCell.FormulaR1C1 = "=CountyYield!R5C[-2]*WeatherLookup_input!RC"
ActiveCell.FormulaR1C1 = _

"=IF(AND(Start!R17C[10]=-1,NOT(ISERROR(VLOOKUP(CrossProduct!RC1-10,weatherdatarange1,1,FALSE)))),VLOOKUP(CrossProd uct!RC1-10,weatherdatarange1,R1C+5,FALSE),VLOOKUP(CrossPro duct!RC1,weatherdatarange1,R1C+5,FALSE))"

Range("F2").Select
Selection.Copy
Range("F2:AC2").Select
ActiveSheet.Paste
Range("F2:AC2").Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste


Range("AD2").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-24]:RC[-13])"
Range("AE2").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-13]:RC[-2])"
Range("AD2:AE2").Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Range("A2:AE2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Set fff = Selection
fff.CurrentRegion.Name = "fffr"
Calculate



cn.Close
Set cn = Nothing

rs.Close
Set rs = Nothing

End Sub


Sub GetTableState(dbPath As String, istate As Integer, icommodity As Long,
ipractice As Integer)

Dim cn As New Connection, rs As Recordset, rngTemp As Range

Set rngTemp =
ThisWorkbook.Sheets("StateYield_input").Range("Sta teYield_input_start")
cn.ConnectionString = CS & dbPath
cn.Open
Set rs = cn.Execute("Select * from [stateyld] where Year = 1970 and " &
"StFips = " & istate & " and CommCode = " & icommodity & " and PracCode = " &
ipractice)

rngTemp.CopyFromRecordset rs
rngTemp.CurrentRegion.Name = "styldrange"

cn.Close
Set cn = Nothing

End Sub

Sub GetTableCounty(dbPath As String, istate As Integer, icommodity As Long,
ipractice As Integer)

Dim cn As New Connection, rs As Recordset, rngTemp As Range
Dim maxlen As Integer
Dim myCount As Integer

Set rngTemp = ThisWorkbook.Sheets("CountyYield").Range("CountyYi eldstart")
cn.ConnectionString = CS & dbPath
cn.Open
Set rs = cn.Execute("Select * from [cntyyld] where (Year = 1970 and Year <=
2003) and StFips =" & istate & "and CommCode=" & icommodity & "and PracCode
= " & ipractice)

rngTemp.CopyFromRecordset rs
rngTemp.CurrentRegion.Name = "cntyyldrange"

Sheets("CountyYield").Select
Range("J9").Select
Range(Selection, Selection.End(xlDown)).Select
myCount = Selection.Count

Range("k9").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-10],styldrange,7,FALSE)"
Range("L9").Select
ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"
Range("M9").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-6],Div_Cnty_Lookup!R1C1:R3343C8,6,FALSE)"
Range("N9").Select
ActiveCell.FormulaR1C1 = "=RC[-13]*10+RC[-1]"
Range("O9").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],fffr,30,FALSE)"
Range("p9").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],fffr,31,FALSE)"
Range("q9").Select
ActiveCell.FormulaR1C1 =
"=R2C7+R2C8*RC[-2]+R2C9*RC[-1]+R2C10*RC[-2]*RC[-2]+R2C11*RC[-1]*RC[-1]"

Range("k9:AH9").Select
Selection.Copy
Range("K9:AH9", "AH" & myCount + 8).Select
ActiveSheet.Paste

Range("R7").Select
ActiveCell.FormulaR1C1 = "=SUM(R[+2]C[0]:R[" & myCount + 1 & "]C[0])"
Selection.Copy
Range("R7:AH7").Select
ActiveSheet.Paste

Range("AI7").Select
ActiveCell.FormulaR1C1 = myCount

Range("L2").Select
ActiveCell.FormulaR1C1 = "=CORREL(R[+7]C[0]:R[" & myCount + 6 &
"]C[0],R[+7]C[+5]:R[" & myCount + 6 & "]C[+5])"

cn.Close
Set cn = Nothing

End Sub


 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Follow Up Macro Question MrAcquire Excel Discussion (Misc queries) 4 February 12th 10 04:55 PM
Array follow up trishnmaine Excel Discussion (Misc queries) 1 September 25th 09 09:38 PM
A follow up Question Andrew Mackenzie Excel Discussion (Misc queries) 4 November 17th 08 02:50 PM
Follow-up AVERAGEIF question Ken[_3_] New Users to Excel 2 April 11th 08 05:45 PM
Follow-Up (Clarification) to MIN question Odawg Excel Discussion (Misc queries) 4 October 20th 05 04:04 AM


All times are GMT +1. The time now is 12:03 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"