Tuesday, December 25, 2018

Import CSV Data into the Worksheet!

Hello Friends! Merry Christmas to all of you and to your friends and family.

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

IsValidPasswordString Function

'Following function will verify if the password string contains following characters or not? Rem : List of Characters Group - ASCII Rem ...