Create Account

Excel VBA Course - From Beginner to Expert

200+ Video Lessons
50+ Hours of Video
200+ Excel Guides

Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)

View Course

Excel Q&A Forum

Pull data CSV/Text file in VBA

I want to choose the file and pull data using CSV or txt format and implement the below functionality. But I don't know how.

Sub EditData2()


Dim wb As Workbook
Dim ws As Worksheet
Dim nws As Worksheet
Dim LastRow As Long
Dim RangeToFilter As Range
Dim DestinationRange As Range
Dim x As Integer

Set wb = ThisWorkbook
Set ws = wb.Worksheets("Records")



LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row


With ws
.Range("P1") = "A_Login"
.Range("Q1") = "B_custom_field: Gender"
.Range("R1") = "D_Email"
End With


' existing coloumn
Set RangeToFilter = ws.Range("A1:R" & LastRow)

'add MY
For i = 2 To LastRow
ws.Cells(i, 16) = "MY" & ws.Cells(i, 1)


'add @xyz.com in email
If ws.Cells(i, 13) = "" Then
ws.Cells(i, 18) = ws.Cells(i, 16) & "@xyz.com"
Else
ws.Cells(i, 18) = ws.Cells(i, 13)
End If



'change gender title
If ws.Cells(i, 2) = "Cik" Then
ws.Cells(i, 17) = "Female"
ElseIf ws.Cells(i, 2) = "Puan" Then
ws.Cells(i, 17) = "Female"
Else: ws.Cells(i, 17) = "Male"
End If

Next i



CriteriaWildCard = Format(Date, "m/dd/yyyy")


ws.Range("T:AL").Clear

' filter inpat/expat and hypen
' filter for date after today and status
With RangeToFilter
    .AutoFilter Field:=10, Criteria1:=">=" & CriteriaWildCard, Operator:=xlOr, _
    Criteria2:="=-"
    .AutoFilter Field:=9, Criteria1:="=Active"
    '.AutoFilter Field:=8, Criteria1:="=Inactive"
    .AutoFilter Field:=14, Criteria1:="=Inpat"
End With

' copy only visible cells
With ws
.Range("T1") = "G_custom_field: Employee ID"
.Range("U1") = "P_Title"
.Range("V1") = "B_Firstname"
.Range("W1") = "C_Lastname"
.Range("X1") = "I_custom_field: Position"
.Range("Y1") = "L_custom_field: Category"
.Range("Z1") = "K_custom_field: Department"
.Range("AA1") = "O_Location"
.Range("AB1") = "F_Active"
.Range("AC1") = "N_custom_field: Last day of work"
.Range("AD1") = "J_custom_field: Date Joined"
.Range("AE1") = "M_custom_field: Line Manager"
.Range("AF1") = "Q_Business_Email_Address"
.Range("AG1") = "R_Expat/Inpat"
.Range("AH1") = "S_Job_Description"
.Range("AI1") = "A_Login"
.Range("AJ1") = "H_custom_field: Gender"
.Range("AK1") = "D_Email"
.Range("AL1") = "E_User-type"
End With

' new existing coloumn
Set DestinationRange = ws.Range("T2:AL2")

ws.Range("A2", ws.Range("A2").End(xlToRight).End(xlDown)).SpecialCells(xlCellTypeVisible) _
.Copy Destination:=DestinationRange

' clear filter
RangeToFilter.AutoFilter

ws.Range("P:R").Clear

Set nws = wb.Worksheets.Add



' set user-type
Dim LRow3 As Long

LRow3 = ws.Cells(Rows.Count, 20).End(xlUp).Row

For e = 2 To LRow3

    ws.Cells(e, 38) = ws.Cells(e, 20)
    Select Case ws.Cells(e, 20)
        Case "00133"
           ws.Cells(e, 38) = "SuperAdmin"
        Case "00012"
           ws.Cells(e, 38) = "Instructor"
        Case Else
           ws.Cells(e, 38) = "Learner"
    End Select
 Next e


'rearrange column
Dim arry As Variant
arry = Array("A_Login", "B_Firstname", "C_Lastname", "D_Email", "E_User-Type", "F_Active", _
"G_custom_field: Employee ID", "H_custom_field: Gender", "I_custom_field: Position", "J_custom_field: Date Joined", _
"K_custom_field: Department", "L_custom_field: Category", "M_custom_field: Line Manager", _
"N_custom_field: Last day of work", "O_Location", "P_Title", "Q_Business_Email_Address", _
"R_Expat/Inpat", "S_Job_Description")


For j = 0 To UBound(arry)
Dim ColNo As Long
ColNo = Application.WorksheetFunction.Match(arry(j), ws.Range("A1:AL1"), 0)
ws.Columns(ColNo).Copy Destination:=nws.Columns(j + 1)

Next j

nws.Range("O:S").Clear

Dim nwsLastRow As Long
nwsLastRow = nws.Cells(Rows.Count, 1).End(xlUp).Row
nwsLastColumn = nws.Cells(1, Columns.Count).End(xlToLeft).Column

'change Active status
For k = 2 To nwsLastRow
If nws.Cells(k, 6) = "Active" Then
nws.Cells(k, 6) = "Yes"
ElseIf nws.Cells(k, 6) = "Inactive" Then
nws.Cells(k, 6) = "Yes"
Else: nws.Cells(k, 6) = "No"
End If
If nws.Cells(k, 14) = "-" Then
nws.Cells(k, 14) = ""
Else: nws.Cells(k, 14) = nws.Cells(k, 14)
 End If

'set date format
 nws.Cells(k, 10) = Format(nws.Cells(k, 10), "dd/mm/yyyy")
 If nws.Cells(k, 14) <> "" Then
 nws.Cells(k, 14) = Format(nws.Cells(k, 14), "dd/mm/yyyy")
 Else: nws.Cells(k, 14) = ""
 End If
Next k

For m = 1 To nwsLastColumn
nws.Cells(1, m) = Right(nws.Cells(1, m), Len(nws.Cells(1, m)) - 2)
Next m


'set font size and autofit all column
With nws
.Cells.Font.Size = 9
.Columns.AutoFit
End With


ws.Range("T:AL").Clear

'add newsheet name
nws.Name = "Filter_" & Format(Date, "yyyymmdd") & wb.Worksheets.Count + 1
End Sub

excelformulas-functionsmacros-vba

posted by: nabila (rep: 8) on Wed Aug 24, 2022 at 4:48 am

Answer

Discuss

Discussion

Thanks for selecting my answer, Nabila. Thought you might comment too (but seems I was wrong!). I just revised the answer but only to correct a few typos.

John_Ru (rep: 6142) Aug 25, '22 at 12:02 pm

Hi John,
It is working now. I'm adding and making some changes as per my requirement. I implement your codes in my new macro. Thanks a lot for your great assistance. You are a mastermind in programmin.

nabila (rep: 8) Aug 26, '22 at 7:13 am

Thanks Nabila, glad it helped. I'm no mastermind (thanks) but apply my moderate knowledge in a methodical way- plus I like solving problems!

John_Ru (rep: 6142) Aug 26, '22 at 7:51 am

Add to Discussion

Answers

Selected Answer

Hi Nabila

In the attached revised file, I added Module 2 with this code to import a chosen CSV file:

Sub ImportCSVorText()

Dim fileToOpen As Variant
Dim fileFilterPattern As String
Dim wsMaster As Worksheet
Dim wbTextImport As Workbook


fileFilterPattern = "Text Files (*.txt; *.csv), *.txt; *.csv"
fileToOpen = Application.GetOpenFilename(fileFilterPattern)

If fileToOpen = False Then
        MsgBox "No file selected"
    Else
    Application.ScreenUpdating = False

    Workbooks.OpenText _
        Filename:=fileToOpen, _
        StartRow:=1, _
        DataType:=xlDelimited, _
        Comma:=True
    Set wbTextImport = ActiveWorkbook
    Set wsMaster = ThisWorkbook.Worksheets("Records")

    wsMaster.UsedRange.Clear

    wbTextImport.Worksheets(1).UsedRange.Copy wsMaster.Range("A1")
    wbTextImport.Close SaveChanges:=False

    Application.ScreenUpdating = True
End If

End Sub

In your existing code, the changes in bold call that sub but the dates need to be corrected (to match other parts of your code) by the lines in bold:

Sub EditData2()

Dim wb As Workbook
Dim ws As Worksheet
Dim nws As Worksheet
Dim LastRow As Long
Dim RangeToFilter As Range
Dim DestinationRange As Range
Dim x As Integer

Set wb = ThisWorkbook
'get data from CSV file
Call ImportCSVorText

Set ws = wb.Worksheets("Records")
' ### correct the csv imported dates to match CriteriaWildCard
ws.Columns("J:K").NumberFormat = "dd-mmm-yyyy"

LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row

Elsewhere (more than once), I made the date formats match (and left a comment to say so) e.g.

' ### changed date format
CriteriaWildCard = Format(Date, "dd-mmm-yyyy")

Now the dates get filtered properly (if they are dates like 15/09/2021 in the sample .csv file "Nabila data v0_a.csv" - which is embedded in the Run worksheet and you can save out to test the import).

Discussion

The Answer file has now been revised to embed a .csv file (for test purposes)- I'd forgotten that only Excel files can be uploaded with a Question or Answer. D'oh!

John_Ru (rep: 6142) Aug 25, '22 at 12:13 pm

Add to Discussion

Excel VBA Course - From Beginner to Expert

Pull data CSV/Text file in VBA

Discussion

Answers

Discussion

Answer the Question

You must create an account to use the forum. Create an Account or Login