Follow up to array question

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

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(CrossProduct!RC1-10,weatherdatarange1,R1C+5,FALSE),VLOOKUP(CrossProduct!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("StateYield_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("CountyYieldstart")
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
 
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! said:
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(CrossProduct!RC1-10,weatherdatarange1,R1C+5,FALSE),VLOOKUP(CrossProduct!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("StateYield_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("CountyYieldstart")
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
Click to expand...
 
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 said:
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! said:
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(CrossProduct!RC1-10,weatherdatarange1,R1C+5,FALSE),VLOOKUP(CrossProduct!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("StateYield_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("CountyYieldstart")
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
Click to expand...
Click to expand...
 
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! said:
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 said:
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! said:
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(CrossProduct!RC1-10,weatherdatarange1,R1C+5,FALSE),VLOOKUP(CrossProduct!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("StateYield_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("CountyYieldstart")
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
Click to expand...
Click to expand...
Click to expand...
 
Thanks Tom. I was able to figure it out with some people at work. I really
appreciate everyones help on this.

Tom Ogilvy said:
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! said:
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 said:
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


:

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(CrossProduct!RC1-10,weatherdatarange1,R1C+5,FALSE),VLOOKUP(CrossProduct!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("StateYield_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("CountyYieldstart")
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
Click to expand...
Click to expand...
Click to expand...
 
Back
Top