Follow up to array question
Thanks Tom. I was able to figure it out with some people at work. I really
appreciate everyones help on this.
"Tom Ogilvy" wrote:
You should get the error message with the choice of hitting the debug button
on the error dialog. Hit the debug button and see which line is highlighted
in yellow.
--
Regards,
Tom Ogilvy
"Need Help Fast!" wrote in message
...
It just says type mismatch when I run it from my first sub. It doesn't
show
where the error is occuring. Again, thanks for your help Tom.
"Tom Ogilvy" wrote:
Missed where you said the error occured and what the value of the
variables
involved in the error were at the time of the error??
--
Regards,
Tom Ogilvy
"Need Help Fast!" wrote:
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
|