Is there a faster way? (vb and Excel)

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.

VB Code:

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

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

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.

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)

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.

VB Code:

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.

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?

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

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.

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

VB Code:

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