Solver randomly quit providing logical values

[rossross]

I have a macro that runs through rows grabbing inputs and placing them on another sheet, solver then computes what the rate should be to make another value equal to 0 then puts the outputs back in the first sheet. I've used it maybe 30 times on projects containing anywhere from 1000 to 3000 rows. two days ago, it randomly stopped giving me logical values. it computes some that makes sense but then starts dumping the same value for large chunks of the data. Using office 365 on this if that helps. i haven't changed any settings and my data contains no errors. On a closer look, stepping through the code, it looks like it might've randomly started to get hung up, repeating the same values?

here's my code.

Option Explicit


Dim wb As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim i As Long
Dim lr As Long
Dim r As Long
Dim tbegin As Variant
Dim tend As Variant

Sub placeinputs()

Set wb = ThisWorkbook
Set ws1 = wb.Worksheets("Calcs")
Set ws2 = wb.Worksheets("Data")

tbegin = Time

Application.EnableEvents = False
Application.ScreenUpdating = False

With ws2
    lr = .Cells(Rows.Count, 1).End(xlUp).Row
    lr = lr - 8
   
    For i = 2 To lr
    ws1.Range("C4").Value2 = ws2.Cells(i, 18).Value2
    ws1.Range("C5").Value2 = ws2.Cells(i, 46).Value2
    ws1.Range("C10").Value2 = ws2.Cells(i, 4).Value2
    ws1.Range("C11").Value2 = ws2.Cells(i, 19).Value2
    ws1.Range("C12").Value2 = ws2.Cells(i, 25).Value2
    ws1.Range("C13").Value2 = ws2.Cells(i, 28).Value2
    ws1.Range("C14").Value2 = ws2.Cells(i, 31).Value2
    ws1.Range("C15").Value2 = ws2.Cells(i, 26).Value2
    ws1.Range("E2").Value2 = ws2.Cells(i, 6).Value2
    ws1.Range("E3").Value2 = ws2.Cells(i, 29).Value2
    ws1.Range("E4").Value2 = ws2.Cells(i, 7).Value2
    ws1.Range("E5").Value2 = ws2.Cells(i, 23).Value2
    ws1.Range("E6").Value2 = ws2.Cells(i, 20).Value2
    ws1.Range("E7").Value2 = ws2.Cells(i, 32).Value2
    ws1.Range("E12").Value2 = ws2.Cells(i, 47).Value2
    Call runsolver
        With ws1
            ws2.Cells(i, 48).Value2 = ws1.Range("H3").Value2
            ws2.Cells(i, 49).Value2 = ws1.Range("H5").Value2
            ws2.Cells(i, 50).Value2 = ws1.Range("H8").Value2
        End With
    Next i
End With

tend = Time

Application.ScreenUpdating = True
Application.EnableEvents = True

MsgBox "Pool Complete" & vbCrLf & "Start Time = " & tbegin & vbCrLf & _
    "It took " & getminsec(CLng((tend - tbegin) * 100000)) _
    & " to complete.", vbInformation, "PROCESSING SUCCESSFUL"
   
End Sub

Sub runsolver()

solverreset

solverok setcell:="$C$8", maxminval:=3, valueof:=0, bychange:="$H$8"

solversolve userfinish:=True

End Sub

Public Function getminsec(ByVal x As Long) As String

Dim strmin As String
Dim strsec As String

strmin = CStr(Int((x / 60)))
strsec = CStr(x - (60 * CLng(strmin)))

strmin = IIf(CLng(strmin) = 1, strmin & " minute", strmin & " minutes")
strsec = IIf(CLng(strsec) = 1, strsec & " second", strsec & " seconds")

getminsec = strmin & ", " & strsec

End Function

 

[NdNoviceHlp]

Not sure if this matters, but you have enable events set to false when you call the solver routine which resets solver at the start of the routine. Maybe trial removing that and see what happens? Maybe trial removing the screen updating too? Just a thought. Dave

 

[rossross]

Not sure if this matters, but you have enable events set to false when you call the solver routine which resets solver at the start of the routine. Maybe trial removing that and see what happens? Maybe trial removing the screen updating too? Just a thought. Dave

will try the events piece. not sure that's the problem though since it's been working with that bit in it. won't enabling screen updating slow it down? it's already a pretty slow routine