Let me share a Christmas present for you all.
Do you want to import CSV file into the sheet and calculate the sum of the column data into the last row?
Well here is the file! and video of the file is in the comment box. Let me know if you guys have any queries.
Thank you. and enjoy your beautiful festival season.
Regards,
Kamal.
Sub ImportCSVFile()
'By Kamal Bharakhda @ 919328093207 [E] kamal.9328093207@gmail.com
Application.ScreenUpdating = False
Dim xFileName As Variant
Dim TargetSheet As Worksheet
Dim Rg As Range
Dim xAddress As String
Dim TargetRange As Range
Set TargetSheet = Sheets("DATABASE")
TargetSheet.UsedRange.Clear
xFileName = Application.GetOpenFilename("CSV File (*.csv), *.csv", , "Kamal Bharakhda", , False)
If xFileName = False Then Exit Sub
On Error Resume Next
Set Rg = TargetSheet.Range("A1")
On Error GoTo 0
If Rg Is Nothing Then Exit Sub
xAddress = Rg.Address
With ActiveSheet.QueryTables.Add("TEXT;" & xFileName, Range(xAddress))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 936
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Set TargetRange = TargetSheet.Range("A:A")
'Splitting the Delimited Strings
TargetRange.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _
True
With TargetSheet
Dim TotalRow As Long
TotalRow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Cells(TotalRow + 1, 3).Value = "Sub Total"
.Cells(TotalRow + 1, 4).Value = Application.WorksheetFunction.Sum(.Range("D2:D" & TotalRow))
With .Rows(TotalRow + 1).Font
.Bold = True
.Size = 13
End With
.UsedRange.Columns.AutoFit
End With
MsgBox "Process Done", vbInformation, "Message from Kamal"
Application.ScreenUpdating = True
End Sub
No comments:
Post a Comment