Code not inserting new row in table, over writes content of next then insert

alan.sluder

New Member
Joined
Aug 29, 2011
Messages
27
When running the following code, instead of inserting a new row in the table and then posting the values. As it loops thru, a new row is inserted and writes down the rows over writing contents that are summing the values in the table.

Code:
Private Sub btnImport_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean, ByVal Action As MSForms.fmAction, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)

End Sub


Public Sub btnImport_Click()
    Dim folderPath As String
    Dim transmittalNo As String
    Dim fileName As String
    Dim numberFiles As Integer
    Dim newData() As String
    
    'Assign Variables
    folderPath = txtPricingFolder.Text
    transmittalNo = txtTransmittalNo.Text
    numberFiles = 0
    
    
    'Validate Variables
    If folderPath = "" Then
        MsgBox ("Please paste in a path to the folder housing the Pricing Forms.")
        Exit Sub
    End If
        
    'Check if there's files in that directory
    fileName = Dir(folderPath & "*.xlsx")
    
    Do While fileName <> ""
        numberFiles = numberFiles + 1
        fileName = Dir()
    Loop
    
    If numberFiles = 0 Then
        MsgBox ("There were no Pricing Files in that directory")
        Exit Sub
    End If
        
    ''''''GET THE DATA FROM THE SPREADSHEETS AND ASSIGN IT TO AN ARRAY ''''''''
    
        Dim ws As Worksheet
    Dim currentRow As Integer
    Dim j As Integer
    Dim sourceWb As Workbook
    Dim thisWb As Workbook: Set thisWb = Application.ActiveWorkbook
    Dim i As Integer
    Dim lineNo As String
    Dim tempLineNo() As String
    Dim intCounter As Integer
    
    
    'First Row of Data Input
    currentRow = 13
    'Avoid Screen Flicker
    Application.ScreenUpdating = False


    fileName = Dir(folderPath & "*.xlsx")
    
    'create an array to store the cell data
   Dim sourceData() As Variant
    
    'set counter to use for redim on array
    i = 0
        
    ReDim Preserve sourceData(numberFiles - 1, 18)
    
    
    Do While fileName <> ""
       
        Debug.Print fileName
       
        'Open the workbook
        Set sourceWb = Workbooks.Open(folderPath & fileName, UpdateLinks:=0, ReadOnly:=True)
                      
                    
        'MAP WORKSHEET DATA TO SOURCEDATA ARRAY
        sourceData(i, 0) = sourceWb.Sheets("Sch B-ISO Price Sht").Range("F3").Value 'CWP No
        sourceData(i, 1) = txtTransmittalNo.Text 'Transmittal No
        sourceData(i, 2) = sourceWb.Sheets("Sch B-ISO Price Sht").Range("F1").Value 'ISO#
        sourceData(i, 3) = sourceWb.Sheets("Sch B-ISO Price Sht").Range("T1").Value 'SHEET#
        
'!!!!!!!!!!!!!!!!!!NEED LOGIC HERE TO START NEW ROW IF THIS VALUE DIFFERS??? NOT SURE!!!!!!!!!!!!!!!!!!!!!!!!!
        sourceData(i, 4) = sourceWb.Sheets("Sch B-ISO Price Sht").Range("AT3").Value 'REVISION
        
        
        'NEED TO SPLIT THESE
        lineNo = sourceWb.Sheets("Sch B-ISO Price Sht").Range("F2").Value 'PIPE CLASS
        tempLineNo = Split(lineNo, "-")
        sourceData(i, 5) = Trim(tempLineNo(5)) 'Pipe Class
        sourceData(i, 6) = Trim(tempLineNo(4)) ''FLUID CODE
        
        sourceData(i, 7) = sourceWb.Sheets("Sch B-ISO Price Sht").Range("AK6").Value 'MATERIAL COST
        sourceData(i, 8) = sourceWb.Sheets("Sch B-ISO Price Sht").Range("AK7").Value 'MATERIAL MARKUP
        sourceData(i, 9) = sourceWb.Sheets("Sch B-ISO Price Sht").Range("AK8").Value 'FIRESTOP
        sourceData(i, 10) = sourceWb.Sheets("Sch B-ISO Price Sht").Range("AK9").Value 'INSULATION
        sourceData(i, 11) = sourceWb.Sheets("Sch B-ISO Price Sht").Range("AK10").Value 'SHOP LABOR-DIRECT
        sourceData(i, 12) = sourceWb.Sheets("Sch B-ISO Price Sht").Range("AK11").Value 'SHOP LABOR-INDIRECT
        sourceData(i, 13) = sourceWb.Sheets("Sch B-ISO Price Sht").Range("L9").Value 'FIELD LABOR
        sourceData(i, 14) = sourceWb.Sheets("Sch B-ISO Price Sht").Range("L7").Value 'MATERIAL TAX
        sourceData(i, 15) = sourceWb.Sheets("Sch B-ISO Price Sht").Range("L11").Value 'SUBCONTRACTORS MARKUP
        sourceData(i, 16) = sourceWb.Sheets("Sch B-ISO Price Sht").Range("L14").Value 'FIRESTOP WORK HRS
        sourceData(i, 17) = sourceWb.Sheets("Sch B-ISO Price Sht").Range("L15").Value 'INSULATOR WORK HRS
        sourceData(i, 18) = sourceWb.Sheets("Sch B-ISO Price Sht").Range("L16").Value 'CONTRACTOR WORK HRS
        
        
                
        'Close the Excel File
        Workbooks(fileName).Close
         
        'Reinitialize the Dir function
        fileName = Dir()
        
        'Next Row
        currentRow = currentRow + 1
                
        i = i + 1
        
        
    Loop
    
    
   '''WRITE TO THE TABLE
   
   Dim table_list_object As ListObject
   Dim table_object_row As ListRow
   Dim thisWs As Worksheet
   
   Set thisWs = thisWb.Worksheets("CO Summary")
   Set table_list_object = thisWs.ListObjects(1) 'THE ONLY TABLE IN THAT WORKSHEET (INDEX 1)
   Set table_object_row = table_list_object.ListRows.Add
      
   For i = 0 To UBound(sourceData)
    table_object_row.Range(i, 1).Value = txtBuilding.Text
    table_object_row.Range(i, 2).Value = sourceData(i, 0)
    table_object_row.Range(i, 3).Value = sourceData(i, 1)
    table_object_row.Range(i, 4).Value = sourceData(i, 2)
    table_object_row.Range(i, 5).Value = sourceData(i, 3)
    table_object_row.Range(i, 6).Value = sourceData(i, 4)
    table_object_row.Range(i, 7).Value = sourceData(i, 5)
    table_object_row.Range(i, 8).Value = sourceData(i, 6)
    table_object_row.Range(i, 10).Value = sourceData(i, 7)
    table_object_row.Range(i, 11).Value = sourceData(i, 8)
    table_object_row.Range(i, 12).Value = sourceData(i, 9)
    table_object_row.Range(i, 13).Value = sourceData(i, 10)
    table_object_row.Range(i, 14).Value = sourceData(i, 11)
    table_object_row.Range(i, 15).Value = sourceData(i, 12)
    table_object_row.Range(i, 16).Value = sourceData(i, 13)
    table_object_row.Range(i, 17).Value = sourceData(i, 14)
    table_object_row.Range(i, 18).Value = sourceData(i, 15)
    table_object_row.Range(i, 20).Value = sourceData(i, 16)
    table_object_row.Range(i, 21).Value = sourceData(i, 17)
    table_object_row.Range(i, 22).Value = sourceData(i, 18)
             
   Next
   
    'Update all formulas
    Application.Calculate
    
    'Update Screen
    Application.ScreenUpdating = True
    
    'Complete
    MsgBox ("Finished")
    
End Sub






Private Sub btnImport_DblClick(ByVal Cancel As MSForms.ReturnBoolean)


End Sub


Private Sub btnImport_Enter()


End Sub


Public Sub UserForm_Activate()


    txtTransmittalNo.Text = "TR-"
    txtTransmittalNo.SetFocus


     
    'Assign default folder path
    txtPricingFolder.Text = Application.ActiveWorkbook.path & "\Pricing Forms\"
    
End Sub
 
Last edited:

Some videos you may like

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.

Watch MrExcel Video

Forum statistics

Threads
1,109,503
Messages
5,529,248
Members
409,857
Latest member
KailuaTown
Top