I'm trying to tweak the code below but I guess I'm rusty. This code opens a csv file, imports selected columns from that file and then it saves the new columns as a new file. Originally I had it so the following columns were imported: "E,H,AF,AU"
I want to change this so that an extra column is imported. i.e. "C,E,H,AF,AU"
When I run the code as is I get the C column but I lose the AU column. I cannot see what other part of the code I need to modify so that I get all five columns - or two or six or whatever number I want down the road. Clearly this code wants to import four columns regardless of what I'm doing. Any suggestions?
I want to change this so that an extra column is imported. i.e. "C,E,H,AF,AU"
When I run the code as is I get the C column but I lose the AU column. I cannot see what other part of the code I need to modify so that I get all five columns - or two or six or whatever number I want down the road. Clearly this code wants to import four columns regardless of what I'm doing. Any suggestions?
HTML:
Private Sub CommandButton1_Click()
i = 1
'Station List goes to 1017
Do While i < 1017
Sheet1.Range("B2").Value = Sheet9.Range("A" & i).Value
'Latitude = Sheet9.Range("F" & i).Value
i = i + 1
Loop
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
' --> User settings, change to suit
Const ChooseStationCell = "B2" ' Validation list cell address
Const FileNameCell = "B2" ' Vlookup formula cell address
Const NewName = "B2"
Const FileNameExt = "CSV" ' External data file extention
Const FileFolder = "C:\Data\TMY3" ' Folder with external data files
Const LinesDelim = vbLf ' Lines delimiter of CSV file
Const DestSheet = "Data" ' Destination sheet name
Const ImportedColumns = "C,E,H,AF,AU" ' Columns to be imported"
' <-- End of User settings
Dim FileName$, FileNo%, r&, i&, txt$, a, b(), x
If Intersect(Target, Range(ChooseStationCell)) Is Nothing Then Exit Sub
Sheets(DestSheet).UsedRange.ClearContents
FileName = FileFolder & IIf(Right(FileFolder, 1) <> "\", "\", "") & Range(FileNameCell) & "." & FileNameExt
If Dir(FileName) = "" Then Exit Sub
' Copy text of CSV-file into variable txt
FileNo = FreeFile
Open FileName For Input As #FileNo
txt = Input(LOF(FileNo), #FileNo)
Close #FileNo
' Convert txt to the lines array a()
a = Split(txt, LinesDelim)
' Copy a() into trasposed b()
ReDim b(0 To UBound(a), 1 To 1)
For Each x In a
b(r, 1) = a(r)
r = r + 1
Next
' Freeze on screen, events, calculations (speeding up)
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
' Copy b() to the destination sheet with TextToColumns conversion
With Sheets(DestSheet).Cells(1, 1).Resize(UBound(a) + 1)
.Value = b()
.TextToColumns Destination:=.Cells(1, 1), Comma:=True, FieldInfo:=Array(1, xlMDYFormat)
.Rows(2).Columns.AutoFit
End With
' Delete all columns but ImportedColumns
With Sheets(DestSheet).UsedRange
For Each x In Split(ImportedColumns, ",")
i = i + 1
.Columns(x).Copy Destination:=.Columns(i)
Next
If i < .Columns.Count Then .Range(.Columns(i + 1), .Columns(.Columns.Count)).ClearContents
End With
' Unfreeze screen, events, calculations
With Application
.Calculation = xlCalculationAutomatic
.EnableEvents = True
.ScreenUpdating = True
End With
Application.DisplayAlerts = False
Sheets("Data2").Copy
ActiveWorkbook.SaveAs FileName:="C:\Data\TMY3ETR\" & Range(NewName) & "." & FileNameExt, FileFormat:=xlCSV, CreateBackup:=False
Application.CutCopyMode = False
ActiveWorkbook.Close
Application.DisplayAlerts = True
End Sub