VB6 - Load creation

Private Sub Command2_Click()
'Form8.Show (False)


    On Error GoTo step_error
    Dim XLS As New Excel.Application
    Dim WRK As Excel.Workbook
    Dim SHT As Excel.Worksheet
    Dim RNG As Excel.Range

    Dim ArrayCells() As Variant
Option1.Value = True
    If Combo2.ListIndex <> -1 Then
        'Create a new instance of Excel
        Set XLS = CreateObject("Excel.Application")
        'Open the XLS file. The two parameters representes, UpdateLink = False and ReadOnly = True. These parameters have this setting to dont occur any error on broken links and allready opened XLS file.
        Set WRK = XLS.Workbooks.Open(Text3.Text, False, True)
        'Set the SHT variable to selected worksheet
        Set SHT = WRK.Worksheets(Combo2.List(Combo2.ListIndex))

        'Get the used range of current worksheet
        Set RNG = SHT.UsedRange

        'Change the dimensions of array to fit the used range of worksheet
        ReDim ArrayCells(1 To RNG.Rows.Count, 1 To RNG.Columns.Count)

        'Transfer values of the used range to new array
        If Option1.Value Then
            ArrayCells = RNG.Value
        ElseIf Option2.Value Then
            ArrayCells = RNG.Formula
        End If

        'Close worksheet
        WRK.Close False
        'Quit the MS Excel
        XLS.Quit

        'Release variables
        Set XLS = Nothing
        Set WRK = Nothing
        Set SHT = Nothing
        Set RNG = Nothing

        'Configure the flexgrid to display data
        MSHFlexGrid_order_extract.Redraw = False
        MSHFlexGrid_order_extract.FixedCols = 0
        MSHFlexGrid_order_extract.FixedRows = 1
        MSHFlexGrid_order_extract.Rows = UBound(ArrayCells, 1)
        MSHFlexGrid_order_extract.Cols = UBound(ArrayCells, 2)
Dim r As Integer
Dim c As Integer
        For r = 0 To UBound(ArrayCells, 1) - 1
            For c = 0 To UBound(ArrayCells, 2) - 1
                MSHFlexGrid_order_extract.TextMatrix(r, c) = CStr(ArrayCells(r + 1, c + 1))
            Next
        Next
        MSHFlexGrid_order_extract.Redraw = True
    Else
        MsgBox "Select the worksheet!", vbCritical
        Combo2.SetFocus
    End If

    'Auto column fit
    Dim cell_wid As Single
    Dim col_wid As Single

    For c = 0 To MSHFlexGrid_order_extract.Cols - 1
        col_wid = 0
        For r = 0 To MSHFlexGrid_order_extract.Rows - 1
            cell_wid = TextWidth(MSHFlexGrid_order_extract.TextMatrix(r, c))
            If col_wid < cell_wid Then col_wid = cell_wid
        Next r
        MSHFlexGrid_order_extract.ColWidth(c) = col_wid + 120
    Next c

    'Count records
    Dim z As Long, txt As String, total As Long
    For z = 1 To MSHFlexGrid_order_extract.Rows - 1
        If Len(MSHFlexGrid_order_extract.TextMatrix(z, 3)) Then total = total + 1
    Next z
    lblTotalrecord1 = CStr(total)

    '---------- Align MSHFlexgrid ----------------
    With MSHFlexGrid_order_extract
        Dim k As Long
        For k = 0 To .Cols - 1
            .ColAlignment(k) = flexAlignLeftCenter
        Next
    End With


    'new
    Dim lngRow As Long
    Dim intStopCount As Integer
    Dim strKey As String
    Dim strDest As String
    Dim intSuffix As Integer
    With MSHFlexGrid_order_extract
        strKey = .TextMatrix(1, 5) & .TextMatrix(1, 55) & .TextMatrix(1, 56) & .TextMatrix(1, 57)
        strDest = .TextMatrix(1, 6)
        intStopCount = 1
        intSuffix = 1
        For lngRow = 1 To .Rows - 1
            If strKey = .TextMatrix(lngRow, 5) & .TextMatrix(lngRow, 55) & .TextMatrix(lngRow, 56) & .TextMatrix(lngRow, 57) Then
                If strDest <> .TextMatrix(lngRow, 6) Then
                    intStopCount = intStopCount + 1
                    If intStopCount > stop_load.Text Then
                        intStopCount = 1
                        intSuffix = intSuffix + 1
                    End If
                    strDest = .TextMatrix(lngRow, 6)
                End If
            Else
                intStopCount = 1
                intSuffix = 1
                strKey = .TextMatrix(lngRow, 5) & .TextMatrix(lngRow, 55) & .TextMatrix(lngRow, 56) & .TextMatrix(lngRow, 57)
            End If
            .TextMatrix(lngRow, 59) = .TextMatrix(lngRow, 56) & "_" & .TextMatrix(lngRow, 57) & "_" & intSuffix
        Next
    End With
    
   ' Unload Form8


    Call MsgBox("File now uploaded in grid", vbInformation Or vbSystemModal Or vbMsgBoxRight Or vbMsgBoxRtlReading, "Excel file uploaded")



    Exit Sub
step_error:
    MsgBox Err.Number & " - " & Err.Description
    Resume Next

End Sub

Select allOpen in new window

    'new
    Dim lngRow As Long
    Dim intStopCount As Integer
    Dim strKey As String
    Dim strDest As String
    Dim intSuffix As Integer
    With MSHFlexGrid_order_extract
        strKey = .TextMatrix(1, 5) & .TextMatrix(1, 55) & .TextMatrix(1, 56) & .TextMatrix(1, 57)
        strDest = .TextMatrix(1, 6)
        intStopCount = 1
        intSuffix = 1
        For lngRow = 1 To .Rows - 1
            If strKey = .TextMatrix(lngRow, 5) & .TextMatrix(lngRow, 55) & .TextMatrix(lngRow, 56) & .TextMatrix(lngRow, 57) Then
                If strDest <> .TextMatrix(lngRow, 6) Then
                    intStopCount = intStopCount + 1
                    If intStopCount > stop_load.Text Then
                        intStopCount = 1
                        intSuffix = intSuffix + 1
                    End If
                    strDest = .TextMatrix(lngRow, 6)
                End If
            Else
                intStopCount = 1
                intSuffix = 1
                strKey = .TextMatrix(lngRow, 5) & .TextMatrix(lngRow, 55) & .TextMatrix(lngRow, 56) & .TextMatrix(lngRow, 57)
            End If
             .TextMatrix(lngRow, 59) = .TextMatrix(lngRow, 5) & "_" & .TextMatrix(lngRow, 56) & "_" & Left$(.TextMatrix(lngRow, 57), 1) & "_" & intSuffix
        Next
    End With

Select allOpen in new window