Hello below is the current code I've been using to import csv file. It works as is but would like to know if its possible to modify what is imported rather than deleting and formatting after it's been imported. I would like to omit columns c,f,h, and i from importing.
Sub ImportCSV()
On Error GoTo eMessage
'set the directory for the exported results folder
If Len(Dir("C:\")) Then
ChDrive "C"
ChDir "C:\LabSave\"
'run the import code (ImportTextFile)
ImportTextFile Fname:=Application.GetOpenFilename(FileFilter:="CSV (Comma Delimited) (*.csv),*.csv"), Sep:=","
If Fname = False Then
Application.ScreenUpdating = True
Exit Sub
End If
Else
retVal = MsgBox("There was an error while connecting to the C: drive. " & vbNewLine & vbNewLine _
& " Select Yes to attempt to find the LabSave folder manually." & vbNewLine & vbNewLine _
& " Select No to cancel the import and verify your network connection.", vbYesNo, "C: drive connection error")
If retVal = vbYes Then
'run the import code (ImportTextFile)
ImportTextFile Fname:=Application.GetOpenFilename(FileFilter:="CSV (Comma delimited) (*.csv),*.csv"), Sep:=","
If Fname = False Then
Application.ScreenUpdating = True
Exit Sub
End If
ElseIf retVal = vbNo Then
Exit Sub
End If
End If
Exit Sub
eMessage:
MsgBox "There was an error while connecting to the C: drive. " & vbNewLine & vbNewLine _
& " Please verify network connection to the C: drive.", vbCritical, "C: drive connection error"
Exit Sub
End Sub
Public Sub ImportTextFile(Fname As String, Sep As String)
Application.ScreenUpdating = False
Application.Cursor = xlWait
Application.DisplayStatusBar = True
Application.StatusBar = "Importing the PLIMS worksheet... "
Dim RowNdx As Long
Dim ColNdx As Integer
Dim TempVal As Variant
Dim WholeLine As String
Dim Pos As Integer
Dim NextPos As Integer
Dim SaveColNdx As Integer
On Error GoTo EndMacro:
SaveColNdx = ActiveCell.Column
RowNdx = ActiveCell.Row
Open Fname For Input Access Read As #1
Dim i As Long
i = 0
While Not EOF(1) And i < 10
Line Input #1, WholeLine
i = i + 1
Wend
While Not EOF(1)
Line Input #1, WholeLine
If Right(WholeLine, 1) <> Sep Then
WholeLine = WholeLine & Sep
End If
ColNdx = SaveColNdx
Pos = 1
NextPos = InStr(Pos, WholeLine, Sep)
While NextPos >= 1
TempVal = Mid(WholeLine, Pos, NextPos - Pos)
Cells(RowNdx, ColNdx).Value = TempVal
Pos = NextPos + 1
ColNdx = ColNdx + 1
NextPos = InStr(Pos, WholeLine, Sep)
Wend
RowNdx = RowNdx + 1
Wend
EndMacro:
On Error GoTo 0
Application.Cursor = xlDefault
Application.StatusBar = False
Application.ScreenUpdating = True
Close #1
End Sub
Sub ImportCSV()
On Error GoTo eMessage
'set the directory for the exported results folder
If Len(Dir("C:\")) Then
ChDrive "C"
ChDir "C:\LabSave\"
'run the import code (ImportTextFile)
ImportTextFile Fname:=Application.GetOpenFilename(FileFilter:="CSV (Comma Delimited) (*.csv),*.csv"), Sep:=","
If Fname = False Then
Application.ScreenUpdating = True
Exit Sub
End If
Else
retVal = MsgBox("There was an error while connecting to the C: drive. " & vbNewLine & vbNewLine _
& " Select Yes to attempt to find the LabSave folder manually." & vbNewLine & vbNewLine _
& " Select No to cancel the import and verify your network connection.", vbYesNo, "C: drive connection error")
If retVal = vbYes Then
'run the import code (ImportTextFile)
ImportTextFile Fname:=Application.GetOpenFilename(FileFilter:="CSV (Comma delimited) (*.csv),*.csv"), Sep:=","
If Fname = False Then
Application.ScreenUpdating = True
Exit Sub
End If
ElseIf retVal = vbNo Then
Exit Sub
End If
End If
Exit Sub
eMessage:
MsgBox "There was an error while connecting to the C: drive. " & vbNewLine & vbNewLine _
& " Please verify network connection to the C: drive.", vbCritical, "C: drive connection error"
Exit Sub
End Sub
Public Sub ImportTextFile(Fname As String, Sep As String)
Application.ScreenUpdating = False
Application.Cursor = xlWait
Application.DisplayStatusBar = True
Application.StatusBar = "Importing the PLIMS worksheet... "
Dim RowNdx As Long
Dim ColNdx As Integer
Dim TempVal As Variant
Dim WholeLine As String
Dim Pos As Integer
Dim NextPos As Integer
Dim SaveColNdx As Integer
On Error GoTo EndMacro:
SaveColNdx = ActiveCell.Column
RowNdx = ActiveCell.Row
Open Fname For Input Access Read As #1
Dim i As Long
i = 0
While Not EOF(1) And i < 10
Line Input #1, WholeLine
i = i + 1
Wend
While Not EOF(1)
Line Input #1, WholeLine
If Right(WholeLine, 1) <> Sep Then
WholeLine = WholeLine & Sep
End If
ColNdx = SaveColNdx
Pos = 1
NextPos = InStr(Pos, WholeLine, Sep)
While NextPos >= 1
TempVal = Mid(WholeLine, Pos, NextPos - Pos)
Cells(RowNdx, ColNdx).Value = TempVal
Pos = NextPos + 1
ColNdx = ColNdx + 1
NextPos = InStr(Pos, WholeLine, Sep)
Wend
RowNdx = RowNdx + 1
Wend
EndMacro:
On Error GoTo 0
Application.Cursor = xlDefault
Application.StatusBar = False
Application.ScreenUpdating = True
Close #1
End Sub