Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
Solved

Adding Excel Solver code to VB6

Posted on 2012-03-22
4
Medium Priority
?
838 Views
Last Modified: 2012-06-21
Hi,

I have a macro in my excel worksheet that I recorded for excel solver.

Now I am trying to get that macro into my vb6 application, but vb6 doesn't recognize the syntax from my macro
0
Comment
Question by:Trying_to_Learn
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
  • 2
4 Comments
 
LVL 14

Expert Comment

by:Brook Braswell
ID: 37752073
Can you post the solver code so I can see what it not recognized ?
0
 

Author Comment

by:Trying_to_Learn
ID: 37752153
Please refer to the following line ... SOLVEROk SetCell:

That's where VB doesn't recognize the code from the macro

Public Sub ExportTOExcel(ByRef Recordset1 As ADODB.Recordset)

'On Error GoTo Err:
    
    Dim i, j As Integer
    Dim createExcel As New Excel.Application
    Dim Wbook As Excel.Workbook
    Dim Wsheet As Excel.Worksheet
    Dim str As Object
    'Dim str1 As String
       
    i = 0
    j = 0


'    With CommDial1
'
'        .CancelError = True
'        .ShowSave
'         str1 = .FileName
'
'   End With
    
    
    Set Wbook = createExcel.Workbooks.Add
    Set Wsheet = Wbook.Worksheets.Add
    'createExcel.Run ("SOLVER.XLA!Auto_Open")
    
    
    With Wsheet
    .Range("AI7").Value = "Budget="
    .Range("AJ7").Value = txt_budget.Text
    .Range("AI9").Value = "Date Selected="
    .Range("AJ9").Value = date_p.Value
    '.Range("C4").Select
    '.Columns("B:B").EntireColumn.AutoFit
    .Range("AI11").Value = "Min # of Companies="
    .Range("AJ11").Value = txt_comp.Text
    
    
    .Range("AI3").Value = "Market Cap"
    'If chk_compnSize.Value = 1 Then
    '.Range("C7").Value = chk_compnSize.Value
    'Else
    '.Range("C7").Value = "0"
    'End If
    
    .Range("AJ2").Value = "Small"
    .Range("AK2").Value = "Medium"
    .Range("AL2").Value = "Large"
    
    
    .Range("AJ3").Value = cs_s.Text
    .Range("AK3").Value = cs_m.Text
    .Range("AL3").Value = cs_l.Text
    
    .Range("AI5").Value = "Volatility"

    'If chk_volatility.Value = 1 Then
    '.Range("C8").Value = chk_volatility.Value
    'Else
    '.Range("C8").Value = "0"
    'End If

    .Range("AJ5").Value = vol_s.Text
    .Range("AK5").Value = vol_m.Text
    .Range("AL5").Value = vol_l.Text
    
    
    .Range("AI4").Value = "Market Sensitivty"
    
    'If chk_risk.Value = 1 Then
    '.Range("C9").Value = chk_risk.Value
    'Else
    '.Range("C9").Value = "0"
    'End If
    
    .Range("AJ4").Value = rsk_s.Text
    .Range("AK4").Value = rsk_m.Text
    .Range("AL4").Value = rsk_l.Text
    '.Range("F10").Select
    '.Columns("C:C").EntireColumn.AutoFit
    
    End With
    
    
    progBar.Max = Recordset1.RecordCount - 1
    
    
   ' For i = 0 To Recordset1.Fields.Count - 1
    '        Wsheet.Cells(11, i + 1).Value = Recordset1.Fields(i).Name
    'Next i
    
    
    If (Recordset1.RecordCount > 0) Then
            
            Recordset1.MoveFirst

             For i = 0 To Recordset1.RecordCount - 1
             
                progBar.Value = i
                SB.SimpleText = "Exported " & Int(progBar.Value * 100 / progBar.Max) & "%"
                SB.Refresh

                    For j = 0 To Recordset1.Fields.Count - 1
                            Wsheet.Cells(i + 3, j + 1).Value = Recordset1(j).Value
                    Next j
            
            Recordset1.MoveNext
            
            Next i
    End If
        
    numComp = Recordset1.RecordCount
    
        
    Wsheet.Range("J2").Value = "Change in Price"
    Wsheet.Range("V2").Value = "Shares Purchased"
    Wsheet.Range("W2").Value = "Dollars Spent"
    Wsheet.Range("X2").Value = "Profit"

    
    For i = 0 To Recordset1.RecordCount - 1
        'Change in Price Calculation
        Wsheet.Cells(i + 3, 10).Value = Wsheet.Cells(i + 3, 3).Value - Wsheet.Cells(i + 3, 7).Value
        'Market Cap Binary Conversion
        If Wsheet.Cells(i + 3, 4).Value = "small" Then Wsheet.Cells(i + 3, 12).Value = 1
        If Wsheet.Cells(i + 3, 4).Value = "medium" Then Wsheet.Cells(i + 3, 13).Value = 1
        If Wsheet.Cells(i + 3, 4).Value = "large" Then Wsheet.Cells(i + 3, 14).Value = 1
        'Volitility Binary Conversion
        If Wsheet.Cells(i + 3, 5).Value = "low" Then Wsheet.Cells(i + 3, 15).Value = 1
        If Wsheet.Cells(i + 3, 5).Value = "medium" Then Wsheet.Cells(i + 3, 16).Value = 1
        If Wsheet.Cells(i + 3, 5).Value = "high" Then Wsheet.Cells(i + 3, 17).Value = 1
        'Market Sensitivity Binary Conversion
        If Wsheet.Cells(i + 3, 6).Value = "low" Then Wsheet.Cells(i + 3, 18).Value = 1
        If Wsheet.Cells(i + 3, 6).Value = "medium" Then Wsheet.Cells(i + 3, 19).Value = 1
        If Wsheet.Cells(i + 3, 6).Value = "high" Then Wsheet.Cells(i + 3, 20).Value = 1
        
        
   
        
        Wsheet.Cells(i + 3, 25).Formula = "=W" & (i + 3) & "*L" & (i + 3) & "/ AJ7"
        Wsheet.Cells(i + 3, 26).Formula = "=W" & (i + 3) & "*M" & (i + 3) & "/ AJ7"
        Wsheet.Cells(i + 3, 27).Formula = "=W" & (i + 3) & "*N" & (i + 3) & "/ AJ7"
        Wsheet.Cells(i + 3, 28).Formula = "=W" & (i + 3) & "*O" & (i + 3) & "/ AJ7"
        Wsheet.Cells(i + 3, 29).Formula = "=W" & (i + 3) & "*P" & (i + 3) & "/ AJ7"
        Wsheet.Cells(i + 3, 30).Formula = "=W" & (i + 3) & "*Q" & (i + 3) & "/ AJ7"
        Wsheet.Cells(i + 3, 31).Formula = "=W" & (i + 3) & "*R" & (i + 3) & "/ AJ7"
        Wsheet.Cells(i + 3, 32).Formula = "=W" & (i + 3) & "*S" & (i + 3) & "/ AJ7"
        Wsheet.Cells(i + 3, 33).Formula = "=W" & (i + 3) & "*T" & (i + 3) & "/ AJ7"

    Next i
    
    'These are the constraints that ensures that the preferences - 1% are preserved
    'low/med/high MKTCAP, low/med/high VOL, low/med/high SENSITIVITY
    Wsheet.Range("AN3").Formula = "=SUM(Y3:Y202)"
    Wsheet.Range("AN4").Formula = "=SUM(Z3:Z202)"
    Wsheet.Range("AN5").Formula = "=SUM(AA3:AA202)"
    Wsheet.Range("AN6").Formula = "=SUM(AB3:AB202)"
    Wsheet.Range("AN7").Formula = "=SUM(AC3:AC202)"
    Wsheet.Range("AN8").Formula = "=SUM(AD3:AD202)"
    Wsheet.Range("AN9").Formula = "=SUM(AE3:AE202)"
    Wsheet.Range("AN10").Formula = "=SUM(AF3:AF202)"
    Wsheet.Range("AN11").Formula = "=SUM(AG3:AG202)"
    
    Wsheet.Range("AP3").Value = (Wsheet.Range("AJ3").Value + 1) / 100
    Wsheet.Range("AP4").Value = (Wsheet.Range("AK3").Value + 1) / 100
    Wsheet.Range("AP5").Value = (Wsheet.Range("AL3").Value + 1) / 100
    Wsheet.Range("AP6").Value = (Wsheet.Range("AJ4").Value + 1) / 100
    Wsheet.Range("AP7").Value = (Wsheet.Range("AK4").Value + 1) / 100
    Wsheet.Range("AP8").Value = (Wsheet.Range("AL4").Value + 1) / 100
    Wsheet.Range("AP9").Value = (Wsheet.Range("AJ5").Value + 1) / 100
    Wsheet.Range("AP10").Value = (Wsheet.Range("AK5").Value + 1) / 100
    Wsheet.Range("AP11").Value = (Wsheet.Range("AL5").Value + 1) / 100
    
    
    
    'These are the constraints that ensures that the preferences + 1% are preserved
    'low/med/high MKTCAP, low/med/high VOL, low/med/high SENSITIVITY
    Wsheet.Range("AN13").Formula = "=SUM(Y3:Y202)"
    Wsheet.Range("AN14").Formula = "=SUM(Z3:Z202)"
    Wsheet.Range("AN15").Formula = "=SUM(AA3:AA202)"
    Wsheet.Range("AN16").Formula = "=SUM(AB3:AB202)"
    Wsheet.Range("AN17").Formula = "=SUM(AC3:AC202)"
    Wsheet.Range("AN18").Formula = "=SUM(AD3:AD202)"
    Wsheet.Range("AN19").Formula = "=SUM(AE3:AE202)"
    Wsheet.Range("AN20").Formula = "=SUM(AF3:AF202)"
    Wsheet.Range("AN21").Formula = "=SUM(AG3:AG202)"
    
    
    Wsheet.Range("AP13").Value = (Wsheet.Range("AJ3").Value - 1) / 100
    Wsheet.Range("AP14").Value = (Wsheet.Range("AK3").Value - 1) / 100
    Wsheet.Range("AP15").Value = (Wsheet.Range("AL3").Value - 1) / 100
    Wsheet.Range("AP16").Value = (Wsheet.Range("AJ4").Value - 1) / 100
    Wsheet.Range("AP17").Value = (Wsheet.Range("AK4").Value - 1) / 100
    Wsheet.Range("AP18").Value = (Wsheet.Range("AL4").Value - 1) / 100
    Wsheet.Range("AP19").Value = (Wsheet.Range("AJ5").Value - 1) / 100
    Wsheet.Range("AP20").Value = (Wsheet.Range("AK5").Value - 1) / 100
    Wsheet.Range("AP21").Value = (Wsheet.Range("AL5").Value - 1) / 100
    
    
    'Budget Constraint
    Wsheet.Range("AN23").Formula = "=SUM(W3:W202)"
    Wsheet.Range("AP23").Value = Wsheet.Range("AJ7")
    
    
    'Minimum Number of Companies Constraint
    Wsheet.Range("AN25").Formula = "=COUNT(V3:V202) - COUNTIF(V3:V202,0)"
    Wsheet.Range("AP25").Value = Wsheet.Range("AJ11")
    
    'Profit (Objective) Cell
    Wsheet.Range("AN27").Formula = "=SUM(X3:X202)"
   

 createExcel.AddIns.Add ("C:\Program Files (x86)\Microsoft Office\Office12\Library\SOLVER\SOLVER.xlam")
    'str = createExcel.AddIns("Solver.xlam").Name
   
   'createExcel.Run "SOLVER.xlam"
    
        
   ' Dim oAddin As AddIn
    
    'Set oAddin = AddIns.Add("C:\Program Files (x86)\Microsoft Office\Office12\Library\SOLVER\SOLVER.xla", True)
    'oAddin.Installed = True
    
     ' Set Solv = AddIns("Solver Add-In")
    'If Solv.Installed = False Then
    '    AddIns("Solver Add-in").Installed = True
    'End If
    
    'createExcel.Run "SOLVER.XLA"
    'createExcel.Run "SOLVER.XLA!Auto_Open"
        
        
   SOLVEROk SetCell:="$AN$27", MaxMinVal:=1, ValueOf:="0", ByChange:="$V$3:$V$202"
    SolverAdd CellRef:="$AN$3:$AN$11", Relation:=1, FormulaText:="$AP$3:$AP$11"
    SolverAdd CellRef:="$AN$13:$AN$21", Relation:=3, FormulaText:="$AP$13:$AP$21"
    SolverAdd CellRef:="$AN$23", Relation:=1, FormulaText:="$AP$23"
    SolverAdd CellRef:="$AN$25", Relation:=3, FormulaText:="$AP$25"
   ' SolverOk SetCell:="$U$104", MaxMinVal:=1, ValueOf:="0", ByChange:="$S$3:$S$102"
    SolverOptions MaxTime:=1000, Iterations:=1000, Precision:=0.000001, AssumeLinear _
        :=False, StepThru:=False, Estimates:=1, Derivatives:=1, SearchOption:=1, _
        IntTolerance:=5, Scaling:=False, Convergence:=0.0001, AssumeNonNeg:=True
    'SolverOk SetCell:="$U$104", MaxMinVal:=1, ValueOf:="0", ByChange:="$S$3:$S$102"
    SolverSolve
        
        
        
        
        
        
        progBar.Visible = False
    
    'Wbook.SaveAs str1
    'Wbook.Close True
    
    createExcel.Visible = True
    
    Set createExcel = Nothing
    Set Wbook = Nothing
    Set Wsheet = Nothing
    'Set Wbook = createExcel.Workbooks.Open(str1)
    
    createExcel.Visible = True
    Exit Sub

Open in new window

0
 
LVL 14

Accepted Solution

by:
Brook Braswell earned 2000 total points
ID: 37752304
Looks like you are going to need to write a Solver Sub manually to "recreate" what the solver did for you in Excel.

alternatively...this link looks promising
http://www.pcreview.co.uk/forums/using-solver-vb6-excel-object-t998763.html
0
 

Author Closing Comment

by:Trying_to_Learn
ID: 37755418
Thanks!
0

Featured Post

Enroll in October's Free Course of the Month

Do you work with and analyze data? Enroll in October's Course of the Month for 7+ hours of SQL training, allowing you to quickly and efficiently store or retrieve data. It's free for Premium Members, Team Accounts, and Qualified Experts!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
If you need to forecast numbers -- typically for finance -- the Windows and Mac versions of Excel 2016 have a basket of tools to get the job done.
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

610 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question