Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Importing from CSV over multiple sheets
Hi,
I have a CSV file that has approximately than 520 fields (yes, I know, it's terrible) that I need to import into Excel. I have found a macro that will let me import up to 510 fields but it cuts off the last 10. That macro can be found he http://support.microsoft.com/default...b;en-us;272729 I have only very limited VB skills and I was wondering if one of you kind people could have a look at the code and tell me where I can change it to let it import over 3 worksheets instead of 2? Thanks very much in advance. Cheers, Verity |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Importing from CSV over multiple sheets
The code below does two things.
The first part generates a comma separated textfile with 50 rows and 600 columns The second procedure reads the file and places the data in sheet1 to sheet3 The workbook has 4 sheets called "main", "sheet1", "sheet2", "sheet3" each sheet will be populated with 255 columns, so as is, you could change the builder to 765 (255x3) , add more sheets if you want more columns the code reads a line in from the csv, drops it into column A of sheet 'main' then copies blocks off 255 rows to to each sheet in turn. I think the code is relatively simple to follow. when you copy the code to a standard module, run the procedure called 'RunTest' ..this will build the demo file & then populatet he workbook. Clear the workbook. You can run the procedure called 'runMain' which allows you to navigate in explorer to your file... Option Explicit Const textFile As String = "c:\temp\textdemo.txt" Sub RunTest() BuildTestFile FetchData textFile End Sub Sub runMain() Dim fn As String fn = Application.GetOpenFilename() If fn < "" Then FetchData fn End If End Sub Sub BuildTestFile() ' set 50 rows Const length As Long = 50 Dim text As String Dim col As Long Dim rw As Long Dim ff As Long ff = FreeFile Open textFile For Output As ff For rw = 1 To length text = "" For col = 1 To 600 text = text & "," & rw & "_" & col Next text = Mid(text, 2) Print #ff, text Next Close End Sub Sub FetchData(sFilename As String) Dim text As String Dim col As Long Dim rw As Long Dim ff As Long Dim data As Variant Dim sheetnumber As Long Dim depth As Long ff = FreeFile Open sFilename For Input As ff Do Until EOF(ff) Line Input #ff, text rw = rw + 1 data = Split(text, ",") depth = UBound(data, 1) Range("A:A").Clear Worksheets("main").Range("A1").Resize(depth) = WorksheetFunction.Transpose(data) For sheetnumber = 1 To Int(depth / 255) + 1 Worksheets("sheet" & sheetnumber).Range("A1").Offset(0, rw - 1).Resize(255).Value = _ Range("A1").Offset(255 * (sheetnumber - 1)).Resize(255).Value Next Loop Close End Sub "Verity" wrote: Hi, I have a CSV file that has approximately than 520 fields (yes, I know, it's terrible) that I need to import into Excel. I have found a macro that will let me import up to 510 fields but it cuts off the last 10. That macro can be found he http://support.microsoft.com/default...b;en-us;272729 I have only very limited VB skills and I was wondering if one of you kind people could have a look at the code and tell me where I can change it to let it import over 3 worksheets instead of 2? Thanks very much in advance. Cheers, Verity |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Importing from CSV over multiple sheets
Hi Patrick,
Thanks for your help. I ran the code and the initial RunTest procedure worked well and filled the rows and columns with the test data. I cleared the worksheet as instructed and ran the RunMain procedure. The procedure placed what should be the column names in the first column on each worksheet and threw this error: Runtime error "-2147417848 (80010108)': Method 'Transpose' of object 'Worksheet Function' Failed. This is where the code is stopped: Worksheets("main").Range("A1").Resize(depth) = WorksheetFunction.Transpose(data) Any clues? Thanks in advance for your help. Verity Any clues as to what this could mean? I'm going to "Patrick Molloy" wrote: The code below does two things. The first part generates a comma separated textfile with 50 rows and 600 columns The second procedure reads the file and places the data in sheet1 to sheet3 The workbook has 4 sheets called "main", "sheet1", "sheet2", "sheet3" each sheet will be populated with 255 columns, so as is, you could change the builder to 765 (255x3) , add more sheets if you want more columns the code reads a line in from the csv, drops it into column A of sheet 'main' then copies blocks off 255 rows to to each sheet in turn. I think the code is relatively simple to follow. when you copy the code to a standard module, run the procedure called 'RunTest' ..this will build the demo file & then populatet he workbook. Clear the workbook. You can run the procedure called 'runMain' which allows you to navigate in explorer to your file... Option Explicit Const textFile As String = "c:\temp\textdemo.txt" Sub RunTest() BuildTestFile FetchData textFile End Sub Sub runMain() Dim fn As String fn = Application.GetOpenFilename() If fn < "" Then FetchData fn End If End Sub Sub BuildTestFile() ' set 50 rows Const length As Long = 50 Dim text As String Dim col As Long Dim rw As Long Dim ff As Long ff = FreeFile Open textFile For Output As ff For rw = 1 To length text = "" For col = 1 To 600 text = text & "," & rw & "_" & col Next text = Mid(text, 2) Print #ff, text Next Close End Sub Sub FetchData(sFilename As String) Dim text As String Dim col As Long Dim rw As Long Dim ff As Long Dim data As Variant Dim sheetnumber As Long Dim depth As Long ff = FreeFile Open sFilename For Input As ff Do Until EOF(ff) Line Input #ff, text rw = rw + 1 data = Split(text, ",") depth = UBound(data, 1) Range("A:A").Clear Worksheets("main").Range("A1").Resize(depth) = WorksheetFunction.Transpose(data) For sheetnumber = 1 To Int(depth / 255) + 1 Worksheets("sheet" & sheetnumber).Range("A1").Offset(0, rw - 1).Resize(255).Value = _ Range("A1").Offset(255 * (sheetnumber - 1)).Resize(255).Value Next Loop Close End Sub "Verity" wrote: Hi, I have a CSV file that has approximately than 520 fields (yes, I know, it's terrible) that I need to import into Excel. I have found a macro that will let me import up to 510 fields but it cuts off the last 10. That macro can be found he http://support.microsoft.com/default...b;en-us;272729 I have only very limited VB skills and I was wondering if one of you kind people could have a look at the code and tell me where I can change it to let it import over 3 worksheets instead of 2? Thanks very much in advance. Cheers, Verity |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Importing from CSV over multiple sheets
"Verity" wrote in message
... Hi, I have a CSV file that has approximately than 520 fields (yes, I know, it's terrible) that I need to import into Excel. I have found a macro that will let me import up to 510 fields but it cuts off the last 10. That macro can be found he http://support.microsoft.com/default...b;en-us;272729 Hi I think the sample code above won't work correctly if a CSV file have data in it something like "123","abc,def". I've tried to modify the code to work in such case, but I'm not sure if this macro would work or not in your case. Just for sample. Sub LargeDatabaseImport3() Dim rec() As String Dim FileName As String Dim FileNum As Integer Dim Counter As Long, maxcol As Long, maxrow As Long Dim Comma As Integer Dim WorkResult As String, tmp As String Dim char As String Dim i As Long, j As Long, k As Long, l As Long, wklen As Long Dim instate As Boolean Dim ws As Worksheet On Error GoTo ErrorCheck maxcol = Cells.Columns.Count maxrow = Cells.Rows.Count 'Ask for the name of the file. FileName = Application.GetOpenFilename(FileFilter:="Text file (*.prn;*.txt;*.csv),*.prn;*.txt;*.csv") 'Check for no entry. If FileName = "False" Then Exit Sub End If 'Turn off ScreenUpdating and Events so that users can't see what is 'happening and can't affect the code while it is running. Application.ScreenUpdating = False Application.EnableEvents = False 'Get next available file handle number. FileNum = FreeFile() 'Open text file for input. Open FileName For Input As #FileNum 'Turn ScreenUpdating off. Application.ScreenUpdating = False 'Set the counter to 1. Counter = 1 'Place the data in the first row of the column. Range("A1").Activate 'Loop until the end of file is reached. Do While Seek(FileNum) <= LOF(FileNum) 'Show row number being imported on status bar. Application.StatusBar = "Importing Row " & _ Counter & " of text file " & FileName 'Store one line of text from file to variable. Line Input #FileNum, WorkResult 'split the entire string and into temporary array rec(). k = 0 i = 1 j = 1 Comma = 0 tmp = "" instate = False wklen = Len(WorkResult) Do While (i <= wklen) char = Mid(WorkResult, i, 1) If char = "," And Not instate Then Comma = Comma + 1 tmp = tmp & char char = Mid(WorkResult, i + 1, 1) If char = "=" Then tmp = tmp & "'" & char i = i + 2 Else i = i + 1 End If ElseIf char = """" And instate Then j = 1 tmp = tmp & char char = Mid(WorkResult, i + j, 1) If char = """" Then Do While (char = """") tmp = tmp & char j = j + 1 char = Mid(WorkResult, i + j, 1) Loop If (j Mod 2) < 0 Then instate = True Else instate = False End If i = i + j Else instate = False i = i + j End If ElseIf char = """" And Not instate Then instate = True tmp = tmp & char i = i + 1 Else tmp = tmp & char i = i + 1 End If If Comma = maxcol Then ReDim Preserve rec(k) rec(k) = Left(tmp, Len(tmp) - 1) k = k + 1 WorkResult = Mid(WorkResult, Len(tmp) + 1) wklen = Len(WorkResult) i = 1 tmp = "" instate = False Comma = 0 End If Loop ReDim Preserve rec(k) rec(k) = tmp i = 1 l = 0 Do While (l <= UBound(rec)) On Error Resume Next Set ws = Nothing Set ws = Worksheets(i) If ws Is Nothing Then Set ws = ActiveWorkbook.Worksheets.Add(after:=ActiveSheet) End If On Error GoTo ErrorCheck ws.Select Cells(Counter, 1) = rec(l) If rec(l) < "" Then Application.DisplayAlerts = False Cells(Counter, 1).TextToColumns Destination:=Cells(Counter, 1), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ Semicolon:=False, Comma:=True, Space:=False, Other:=False 'FieldInfo _ :=Array(Array(1, 1), Array(4, 1)) End If l = l + 1 i = i + 1 Loop Counter = Counter + 1 If Counter maxrow Then MsgBox "data have over max rows" Exit Sub End If ReDim rec(0) Loop 'Close the open text file. Close 'Reset the application to its normal operating environment. Application.StatusBar = False Application.EnableEvents = True Application.ScreenUpdating = True Exit Sub ErrorCheck: 'Reset the application to its normal operating environment. Application.StatusBar = False Application.EnableEvents = True Application.ScreenUpdating = True MsgBox "An error occured in the code." End Sub keizi |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Importing from CSV over multiple sheets
Oh wow, that worked absolutely perfectly! Thanks so much for your help! I am
forever in your debt :-) Cheers, Verity "kounoike" wrote: "Verity" wrote in message ... Hi, I have a CSV file that has approximately than 520 fields (yes, I know, it's terrible) that I need to import into Excel. I have found a macro that will let me import up to 510 fields but it cuts off the last 10. That macro can be found he http://support.microsoft.com/default...b;en-us;272729 Hi I think the sample code above won't work correctly if a CSV file have data in it something like "123","abc,def". I've tried to modify the code to work in such case, but I'm not sure if this macro would work or not in your case. Just for sample. Sub LargeDatabaseImport3() Dim rec() As String Dim FileName As String Dim FileNum As Integer Dim Counter As Long, maxcol As Long, maxrow As Long Dim Comma As Integer Dim WorkResult As String, tmp As String Dim char As String Dim i As Long, j As Long, k As Long, l As Long, wklen As Long Dim instate As Boolean Dim ws As Worksheet On Error GoTo ErrorCheck maxcol = Cells.Columns.Count maxrow = Cells.Rows.Count 'Ask for the name of the file. FileName = Application.GetOpenFilename(FileFilter:="Text file (*.prn;*.txt;*.csv),*.prn;*.txt;*.csv") 'Check for no entry. If FileName = "False" Then Exit Sub End If 'Turn off ScreenUpdating and Events so that users can't see what is 'happening and can't affect the code while it is running. Application.ScreenUpdating = False Application.EnableEvents = False 'Get next available file handle number. FileNum = FreeFile() 'Open text file for input. Open FileName For Input As #FileNum 'Turn ScreenUpdating off. Application.ScreenUpdating = False 'Set the counter to 1. Counter = 1 'Place the data in the first row of the column. Range("A1").Activate 'Loop until the end of file is reached. Do While Seek(FileNum) <= LOF(FileNum) 'Show row number being imported on status bar. Application.StatusBar = "Importing Row " & _ Counter & " of text file " & FileName 'Store one line of text from file to variable. Line Input #FileNum, WorkResult 'split the entire string and into temporary array rec(). k = 0 i = 1 j = 1 Comma = 0 tmp = "" instate = False wklen = Len(WorkResult) Do While (i <= wklen) char = Mid(WorkResult, i, 1) If char = "," And Not instate Then Comma = Comma + 1 tmp = tmp & char char = Mid(WorkResult, i + 1, 1) If char = "=" Then tmp = tmp & "'" & char i = i + 2 Else i = i + 1 End If ElseIf char = """" And instate Then j = 1 tmp = tmp & char char = Mid(WorkResult, i + j, 1) If char = """" Then Do While (char = """") tmp = tmp & char j = j + 1 char = Mid(WorkResult, i + j, 1) Loop If (j Mod 2) < 0 Then instate = True Else instate = False End If i = i + j Else instate = False i = i + j End If ElseIf char = """" And Not instate Then instate = True tmp = tmp & char i = i + 1 Else tmp = tmp & char i = i + 1 End If If Comma = maxcol Then ReDim Preserve rec(k) rec(k) = Left(tmp, Len(tmp) - 1) k = k + 1 WorkResult = Mid(WorkResult, Len(tmp) + 1) wklen = Len(WorkResult) i = 1 tmp = "" instate = False Comma = 0 End If Loop ReDim Preserve rec(k) rec(k) = tmp i = 1 l = 0 Do While (l <= UBound(rec)) On Error Resume Next Set ws = Nothing Set ws = Worksheets(i) If ws Is Nothing Then Set ws = ActiveWorkbook.Worksheets.Add(after:=ActiveSheet) End If On Error GoTo ErrorCheck ws.Select Cells(Counter, 1) = rec(l) If rec(l) < "" Then Application.DisplayAlerts = False Cells(Counter, 1).TextToColumns Destination:=Cells(Counter, 1), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ Semicolon:=False, Comma:=True, Space:=False, Other:=False 'FieldInfo _ :=Array(Array(1, 1), Array(4, 1)) End If l = l + 1 i = i + 1 Loop Counter = Counter + 1 If Counter maxrow Then MsgBox "data have over max rows" Exit Sub End If ReDim rec(0) Loop 'Close the open text file. Close 'Reset the application to its normal operating environment. Application.StatusBar = False Application.EnableEvents = True Application.ScreenUpdating = True Exit Sub ErrorCheck: 'Reset the application to its normal operating environment. Application.StatusBar = False Application.EnableEvents = True Application.ScreenUpdating = True MsgBox "An error occured in the code." End Sub keizi |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Importing from CSV over multiple sheets
Hi,Verity
Thanks for the feedback. Regards keizi kounoike |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
multiple sheets when importing into excel | Excel Worksheet Functions | |||
IMPORTING SHEETS | New Users to Excel | |||
Importing data from several sheets, to one chart | Charts and Charting in Excel | |||
importing sheets | Excel Programming | |||
Excel VBA - Importing columns from different sheets | Excel Programming |