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:
