Is there a faster way? (vb and Excel)

[scostell]

I have Created an app that can open up an excel template, let the user enter info and then I save the entered info to my SQL database. What I do for easy cell access I have defined a name for each cell the user can enter info into so i can track down where the info came from. here is my code to save the excel info into SQL.

Private Sub SaveInfo()
On Error GoTo Handler
    Dim info() As String, test() As String
    Dim strSummary As String
    Dim i As Integer
    Dim strPricing As String
    
    'MouseIcon = vbHourglass
    
    ReDim info(0)
    With xls
        Dim a As String, b As String, c As String
        
        '--Set intial and max value for progress bar
        pbExcel.Value = 0
        pbExcel.Max = .Workbooks(1).Names.Count
        
        '--loop thru all the Excel work book Names
        '---This also includes some names that were probably pre-defined
        For i = 1 To .Workbooks(1).Names.Count
            Debug.Print i
            
            '--This function Figures out which sheet the Name came from.
            '--If the Name is not a name I defined the return value is "Stop"
            a = GetSheet(.Workbooks(1).Names(i).Name)
            Debug.Print .Workbooks(1).Names(i).Name
            
            '--If the defined name leads with "S_" then add value to strSummary
            If Left(.Workbooks(1).Names(i).Name, 2) = "S_" Then
                'Debug.Assert .Workbooks(1).Names(i).Name <> "S_OtherHO"
                strSummary = strSummary & .Sheets(a).Range(.Workbooks(1).Names(i).Name).Value & "@" & .Workbooks(1).Names(i).Name & ";"
            Else
                '--If Sheet doesn't equal Stop then it is a name I assigned to the cell
                If a <> "Stop" Then
                                        
                    '--EX: 1.25 @ FLD_CELL
                    strPricing = .Sheets(a).Range(.Workbooks(1).Names(i).Name).Value & "@" & .Workbooks(1).Names(i).Name & ","
                                    End If
            End If
            pbExcel.Value = i
        Next i
    End With
        
    AddPricingInfo strPricing, strSummary
    'Screen.MousePointer = 99
    MsgBox "Saved Successfully", vbInformation
Exit Sub
Handler:
    Select Case Err.Number
        Case 13
            Resume Next
        Case Else
            Err.Raise Err.Number, Err.Source, Err.Description
    End Select
End Sub

The code is a bit ugly, but it works. The only problem is there are roughly 600 cells this thing has to go thru and it take about 15-20 seconds to do so. Can anyone come up with a faster way of doing this?

The reason I Concatinate all the cell values together is, so i can store the value in only one field in my database. The alternative would be to make 600 columns, not a very nice option.

again, any suggestions on how to speed this up would be GREATLY appreciated.

Scott

[beasty1711]

excel is very slow at the best of times, i would use a VB app and stick the data into arrays

it will run a lot quicker then

[DerFarm]

I'm not sure that you CAN speed the process up, except possibly
marginally with more efficient code.

1. You define a to be the workbook name and yet you
use .workbook.name....... to make a comparision against "S_"

Unless I'm mistaken, you should be using a there.

2. Check for Stop immediately. You go through two checks prior,
each of which costs time.

Like I said, this won't help much, but I'm going to keep thinking.

Interesting problem.

[scostell]

The Excel Template is a Pre-existing Detailed Financial spreadsheet that has tons of info and calculations. I would REALLY REALLY hate having to recreate it in VB.

I guess there is no way of making my way go faster. Maybe I can incrementaly save parts of it. That would help.

Does anyone know how to only select defined Cell names from a particular Page?

excel.application.workbook(1).Names(i).Name will get them from the entire workbook I know for sure.(if you run a loop with i)

[scostell]

The Reason i need to go get the Workbook Name is that the name I defined for each cell has in it a reference to the Sheet the Cell is located on.

Private Function GetSheet(ByVal s As String) As String
On Error GoTo Handler
    Dim Field As String
    Field = GetField(s)
    Select Case Left(Field, InStr(Field, "_") - 1)
        Case "Summary", "S"
            GetSheet = "Summary"
        Case "HO"
            GetSheet = "Home Office Svcs. "
        Case "HO1"
            GetSheet = "H.O. Phase1"
        Case "HO2", "NO2"
            GetSheet = "H.O. Phase 2"
        Case "FSS"
            GetSheet = "Fld.Svcs.& Support"
        Case "ME"
            GetSheet = "Mat's.& Equip."
        Case "C"
            GetSheet = "Construction"
        Case Else
            'MsgBox Left(Field, InStr(Field, "_") - 1)
            GetSheet = "Stop"
    End Select
Exit Function
Handler:
    Select Case Err.Number
        Case 5 '-invalid procedure call or argument
            Resume Next
        Case Else
            Err.Raise Err.Number, Err.Source, Err.Description
    End Select
End Function

an example of a cell name would be: HO_ManHours

I do it this way becuase I don't yet know how to determine the Cell location (which page it's on) thru VB yet. If it's possible.

[DerFarm]

Would it be possible for you to take a screen shot of one of the
Excell sheets you are using. I'm very optically oriented and I'm
having difficulty "seeing" the problem.

Maybe you could attach a spreadsheet?

[oldharley]

The simplest way would be to add one more sheet to excel which contains a single range name consisting of all the vaules referenced from the source sheets. This way you would be able to use column names to explain the data value and a simple way to retreive the data from VB

[scostell]

I just found that if you use:

.Workbooks(1).Names(i).RefersTo


it will give you something like this

=HomeOffice!$G$37


This will help me out, I wan't have to figure out which sheet it is on now.

[scostell]

I Re-Wrote the code to use the ReferTo property and it seems to have cut the save time in half.

Private Sub SaveInfo2()
On Error GoTo Handler
    Dim Info() As String
    Dim strPricing As String, strSummary As String
    Dim i As Integer
        
    ReDim Info(0)
    With xls
        '--Set intial and max value for progress bar
        pbExcel.Value = 0
        pbExcel.Max = .Workbooks(1).Names.Count
        
        For i = 1 To .Workbooks(1).Names.Count
            Debug.Print .Workbooks(1).Names(i).RefersTo
            'Debug.Print Replace(Left(.Workbooks(1).Names(i).RefersTo, InStr(.Workbooks(1).Names(i).RefersTo, "!") - 1), "=", "")
                   
            If InStr(.Workbooks(1).Names(i).RefersTo, "S_") Then
                    strSummary = strSummary & Replace(.Range(Replace(.Workbooks(1).Names(i).RefersTo, "=", "")).Value & .Workbooks(1).Names(i).RefersTo, "=", "@")
                If Info(0) <> "" Then ReDim Preserve Info(UBound(Info) + 1)
                '--EX: 1.25 @ FLD_CELL
                Info(UBound(Info)) = Replace(.Range(Replace(.Workbooks(1).Names(i).RefersTo, "=", "")).Value & .Workbooks(1).Names(i).RefersTo, "=", "@")
                Debug.Print Info(UBound(Info))
            End If
            pbExcel.Value = i
        Next i
    End With
    
    For i = 0 To UBound(Info)
        strPricing = strPricing & Info(i) & ","
    Next i
    
    AddPricingInfo strPricing, strSummary
    'Screen.MousePointer = 99
    MsgBox "Saved Successfully", vbInformation
    
Exit Sub
Handler:
    Resume Next
    Err.Raise Err.Number, Err.Source, Err.Description
End Sub