Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Follow Up Macro Question | Excel Discussion (Misc queries) | |||
Array follow up | Excel Discussion (Misc queries) | |||
A follow up Question | Excel Discussion (Misc queries) | |||
Follow-up AVERAGEIF question | New Users to Excel | |||
Follow-Up (Clarification) to MIN question | Excel Discussion (Misc queries) |