Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Excel macro range problem
I created a macro to select multiple files that are over 256 fields in length
to 2 worksheets in a book. I'm having trouble offsetting the row by 1. Another words, I can load the file successfully each time but overwrite it in row 1...it won't write the next file in row 2, etc.... Can someone help me, I'm a novice at best with code? I managed to modify it to select multiple files successfully.... Sub LargeDatabaseImport() 'In the event of an error, make sure the application is reset to 'normal. 'On Error GoTo ErrorCheck 'Dimension Variables Dim ResultStr As String Dim strTempFileName As String Dim FileNum As Integer Dim Counter As Double Dim CommaCount As Integer Dim WorkResult As String 'OpenFiles Dim fd As FileDialog Dim itm As Variant Set fd = Application.FileDialog(msoFileDialogOpen) With fd .AllowMultiSelect = True .Filters.Add "Excel Files", "*.txt", 1 .InitialFileName = "Z:\Inspection Project 2004\FIL files from forms06\*.txt" If .Show = -1 Then For Each itm In fd.SelectedItems 'Workbooks.Open itm '_________________________________________________ __ '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 'Check for no entry. 'If FileName = "" Then End If itm = "" Then End 'Get next available file handle number. FileNum = FreeFile() 'Open text file for input. 'Open FileName For Input As #FileNum Open itm 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) strTempFileName = Right(itm, 12) MsgBox "file = " & strTempFileName 'Show row number being imported on status bar. Application.StatusBar = "Importing Row " & _ Counter & " of text file " & itm 'Counter & " of text file " & FileName 'Store one line of text from file to variable. Line Input #FileNum, ResultStr 'Initialize the CommaCount variable to zero. CommaCount = 0 'Store the entire string into a second, temporary string. WorkResult = ResultStr 'Parse through the first line of data and separate out records '257 to 510. While CommaCount < 255 WorkResult = Right(WorkResult, Len(WorkResult) - InStr(1, WorkResult, ",")) CommaCount = CommaCount + 1 Wend 'Parse out any leading spaces. If Left(WorkResult, 1) = " " Then WorkResult = Right(WorkResult, Len(WorkResult) - 1) 'Ensure that any records that contain an "=" sign are 'brought in as text, and set the value of the current 'cell to the first 256 records. If Left(WorkResult, 1) = "=" Then ActiveCell.Value = "'" & Left(ResultStr, Len(ResultStr) - Len(WorkResult)) Else ActiveCell.Value = Left(ResultStr, Len(ResultStr) - Len(WorkResult)) End If 'Ensure that any records that contain an "=" sign are 'brought in as text,and set the value of the next cell 'to the last 256 records. If Left(WorkResult, 1) = "=" Then ActiveCell.Offset(0, 1).Value = "'" & WorkResult Else ActiveCell.Offset(0, 1).Value = WorkResult End If 'Move down one cell. ActiveCell.Offset(1, 0).Activate 'Increment the Counter by 1. Counter = Counter + 1 'start again at top of 'Do While' statement. Loop 'Close the open text file. Close 'Take records 257-510 and move them to sheet two. Columns("B:B").Select Selection.Cut Sheets("Sheet2").Select Columns("A:A").Select ActiveSheet.Paste Worksheets("sheet2").Range("iv:iv").Value = strTempFileName '<<<wrong..want it to put the filename in the last column of sheet2 for each record. ' .Visible = True '.Text = strtempfilename 'Run the text-to-columns wizard on both sheets. 'putting text to columns Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _ :=Array(Array(1, 1), Array(2, 1), Array(3, 1)) Sheets("Sheet1").Select Columns("A:A").Select Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _ :=Array(Array(1, 1), Array(2, 1), Array(3, 1)) 'Reset the application to its normal operating environment. Application.StatusBar = False Application.EnableEvents = True Application.ScreenUpdating = True Next Else Exit Sub End If End With Set fd = Nothing 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 Please help. |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Excel macro range problem
try this
from: 'Take records 257-510 and move them to sheet two. Columns("B:B").Select Selection.Cut Sheets("Sheet2").Select Columns("A:A").Select ActiveSheet.Paste Worksheets("sheet2").Range("iv:iv").Value = strTempFileName '<<<wrong..want it to put the filename in the last column of sheet2 for each record. to ------------------------------------------------------------------------------- Columns("B:B").Cut _ Destination:=Sheets("Sheet2").Columns("A:A") Worksheets("sheet2").activate Worksheets("sheet2").Range("iv:iv").Value = strTempFileName "McDal" wrote: I created a macro to select multiple files that are over 256 fields in length to 2 worksheets in a book. I'm having trouble offsetting the row by 1. Another words, I can load the file successfully each time but overwrite it in row 1...it won't write the next file in row 2, etc.... Can someone help me, I'm a novice at best with code? I managed to modify it to select multiple files successfully.... Sub LargeDatabaseImport() 'In the event of an error, make sure the application is reset to 'normal. 'On Error GoTo ErrorCheck 'Dimension Variables Dim ResultStr As String Dim strTempFileName As String Dim FileNum As Integer Dim Counter As Double Dim CommaCount As Integer Dim WorkResult As String 'OpenFiles Dim fd As FileDialog Dim itm As Variant Set fd = Application.FileDialog(msoFileDialogOpen) With fd .AllowMultiSelect = True .Filters.Add "Excel Files", "*.txt", 1 .InitialFileName = "Z:\Inspection Project 2004\FIL files from forms06\*.txt" If .Show = -1 Then For Each itm In fd.SelectedItems 'Workbooks.Open itm '_________________________________________________ __ '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 'Check for no entry. 'If FileName = "" Then End If itm = "" Then End 'Get next available file handle number. FileNum = FreeFile() 'Open text file for input. 'Open FileName For Input As #FileNum Open itm 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) strTempFileName = Right(itm, 12) MsgBox "file = " & strTempFileName 'Show row number being imported on status bar. Application.StatusBar = "Importing Row " & _ Counter & " of text file " & itm 'Counter & " of text file " & FileName 'Store one line of text from file to variable. Line Input #FileNum, ResultStr 'Initialize the CommaCount variable to zero. CommaCount = 0 'Store the entire string into a second, temporary string. WorkResult = ResultStr 'Parse through the first line of data and separate out records '257 to 510. While CommaCount < 255 WorkResult = Right(WorkResult, Len(WorkResult) - InStr(1, WorkResult, ",")) CommaCount = CommaCount + 1 Wend 'Parse out any leading spaces. If Left(WorkResult, 1) = " " Then WorkResult = Right(WorkResult, Len(WorkResult) - 1) 'Ensure that any records that contain an "=" sign are 'brought in as text, and set the value of the current 'cell to the first 256 records. If Left(WorkResult, 1) = "=" Then ActiveCell.Value = "'" & Left(ResultStr, Len(ResultStr) - Len(WorkResult)) Else ActiveCell.Value = Left(ResultStr, Len(ResultStr) - Len(WorkResult)) End If 'Ensure that any records that contain an "=" sign are 'brought in as text,and set the value of the next cell 'to the last 256 records. If Left(WorkResult, 1) = "=" Then ActiveCell.Offset(0, 1).Value = "'" & WorkResult Else ActiveCell.Offset(0, 1).Value = WorkResult End If 'Move down one cell. ActiveCell.Offset(1, 0).Activate 'Increment the Counter by 1. Counter = Counter + 1 'start again at top of 'Do While' statement. Loop 'Close the open text file. Close 'Take records 257-510 and move them to sheet two. Columns("B:B").Select Selection.Cut Sheets("Sheet2").Select Columns("A:A").Select ActiveSheet.Paste Worksheets("sheet2").Range("iv:iv").Value = strTempFileName '<<<wrong..want it to put the filename in the last column of sheet2 for each record. ' .Visible = True '.Text = strtempfilename 'Run the text-to-columns wizard on both sheets. 'putting text to columns Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _ :=Array(Array(1, 1), Array(2, 1), Array(3, 1)) Sheets("Sheet1").Select Columns("A:A").Select Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _ :=Array(Array(1, 1), Array(2, 1), Array(3, 1)) 'Reset the application to its normal operating environment. Application.StatusBar = False Application.EnableEvents = True Application.ScreenUpdating = True Next Else Exit Sub End If End With Set fd = Nothing 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 Please help. |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Excel macro range problem
Thanks, but the "iv:iv" but the filename in every single row. I only want it
in the last cell of the row it's writing to. "Joel" wrote: try this from: 'Take records 257-510 and move them to sheet two. Columns("B:B").Select Selection.Cut Sheets("Sheet2").Select Columns("A:A").Select ActiveSheet.Paste Worksheets("sheet2").Range("iv:iv").Value = strTempFileName '<<<wrong..want it to put the filename in the last column of sheet2 for each record. to ------------------------------------------------------------------------------- Columns("B:B").Cut _ Destination:=Sheets("Sheet2").Columns("A:A") Worksheets("sheet2").activate Worksheets("sheet2").Range("iv:iv").Value = strTempFileName "McDal" wrote: I created a macro to select multiple files that are over 256 fields in length to 2 worksheets in a book. I'm having trouble offsetting the row by 1. Another words, I can load the file successfully each time but overwrite it in row 1...it won't write the next file in row 2, etc.... Can someone help me, I'm a novice at best with code? I managed to modify it to select multiple files successfully.... Sub LargeDatabaseImport() 'In the event of an error, make sure the application is reset to 'normal. 'On Error GoTo ErrorCheck 'Dimension Variables Dim ResultStr As String Dim strTempFileName As String Dim FileNum As Integer Dim Counter As Double Dim CommaCount As Integer Dim WorkResult As String 'OpenFiles Dim fd As FileDialog Dim itm As Variant Set fd = Application.FileDialog(msoFileDialogOpen) With fd .AllowMultiSelect = True .Filters.Add "Excel Files", "*.txt", 1 .InitialFileName = "Z:\Inspection Project 2004\FIL files from forms06\*.txt" If .Show = -1 Then For Each itm In fd.SelectedItems 'Workbooks.Open itm '_________________________________________________ __ '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 'Check for no entry. 'If FileName = "" Then End If itm = "" Then End 'Get next available file handle number. FileNum = FreeFile() 'Open text file for input. 'Open FileName For Input As #FileNum Open itm 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) strTempFileName = Right(itm, 12) MsgBox "file = " & strTempFileName 'Show row number being imported on status bar. Application.StatusBar = "Importing Row " & _ Counter & " of text file " & itm 'Counter & " of text file " & FileName 'Store one line of text from file to variable. Line Input #FileNum, ResultStr 'Initialize the CommaCount variable to zero. CommaCount = 0 'Store the entire string into a second, temporary string. WorkResult = ResultStr 'Parse through the first line of data and separate out records '257 to 510. While CommaCount < 255 WorkResult = Right(WorkResult, Len(WorkResult) - InStr(1, WorkResult, ",")) CommaCount = CommaCount + 1 Wend 'Parse out any leading spaces. If Left(WorkResult, 1) = " " Then WorkResult = Right(WorkResult, Len(WorkResult) - 1) 'Ensure that any records that contain an "=" sign are 'brought in as text, and set the value of the current 'cell to the first 256 records. If Left(WorkResult, 1) = "=" Then ActiveCell.Value = "'" & Left(ResultStr, Len(ResultStr) - Len(WorkResult)) Else ActiveCell.Value = Left(ResultStr, Len(ResultStr) - Len(WorkResult)) End If 'Ensure that any records that contain an "=" sign are 'brought in as text,and set the value of the next cell 'to the last 256 records. If Left(WorkResult, 1) = "=" Then ActiveCell.Offset(0, 1).Value = "'" & WorkResult Else ActiveCell.Offset(0, 1).Value = WorkResult End If 'Move down one cell. ActiveCell.Offset(1, 0).Activate 'Increment the Counter by 1. Counter = Counter + 1 'start again at top of 'Do While' statement. Loop 'Close the open text file. Close 'Take records 257-510 and move them to sheet two. Columns("B:B").Select Selection.Cut Sheets("Sheet2").Select Columns("A:A").Select ActiveSheet.Paste Worksheets("sheet2").Range("iv:iv").Value = strTempFileName '<<<wrong..want it to put the filename in the last column of sheet2 for each record. ' .Visible = True '.Text = strtempfilename 'Run the text-to-columns wizard on both sheets. 'putting text to columns Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _ :=Array(Array(1, 1), Array(2, 1), Array(3, 1)) Sheets("Sheet1").Select Columns("A:A").Select Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _ :=Array(Array(1, 1), Array(2, 1), Array(3, 1)) 'Reset the application to its normal operating environment. Application.StatusBar = False Application.EnableEvents = True Application.ScreenUpdating = True Next Else Exit Sub End If End With Set fd = Nothing 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 Please help. |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Excel macro range problem
Not sure which definiation of last row you mean
for last cell of worksheet Worksheets("sheet2").activate Worksheets("sheet2").cells(rows.count,"iv").Value = strTempFileName For cell immediattely following the cell of data Lastrow = Worksheets("sheet2").cells(rows.count,"iv").end(xl up).row Worksheets("sheet2").activate Worksheets("sheet2").cells(LasrRow + 1,"iv").Value = strTempFileName "McDal" wrote: Thanks, but the "iv:iv" but the filename in every single row. I only want it in the last cell of the row it's writing to. "Joel" wrote: try this from: 'Take records 257-510 and move them to sheet two. Columns("B:B").Select Selection.Cut Sheets("Sheet2").Select Columns("A:A").Select ActiveSheet.Paste Worksheets("sheet2").Range("iv:iv").Value = strTempFileName '<<<wrong..want it to put the filename in the last column of sheet2 for each record. to ------------------------------------------------------------------------------- Columns("B:B").Cut _ Destination:=Sheets("Sheet2").Columns("A:A") Worksheets("sheet2").activate Worksheets("sheet2").Range("iv:iv").Value = strTempFileName "McDal" wrote: I created a macro to select multiple files that are over 256 fields in length to 2 worksheets in a book. I'm having trouble offsetting the row by 1. Another words, I can load the file successfully each time but overwrite it in row 1...it won't write the next file in row 2, etc.... Can someone help me, I'm a novice at best with code? I managed to modify it to select multiple files successfully.... Sub LargeDatabaseImport() 'In the event of an error, make sure the application is reset to 'normal. 'On Error GoTo ErrorCheck 'Dimension Variables Dim ResultStr As String Dim strTempFileName As String Dim FileNum As Integer Dim Counter As Double Dim CommaCount As Integer Dim WorkResult As String 'OpenFiles Dim fd As FileDialog Dim itm As Variant Set fd = Application.FileDialog(msoFileDialogOpen) With fd .AllowMultiSelect = True .Filters.Add "Excel Files", "*.txt", 1 .InitialFileName = "Z:\Inspection Project 2004\FIL files from forms06\*.txt" If .Show = -1 Then For Each itm In fd.SelectedItems 'Workbooks.Open itm '_________________________________________________ __ '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 'Check for no entry. 'If FileName = "" Then End If itm = "" Then End 'Get next available file handle number. FileNum = FreeFile() 'Open text file for input. 'Open FileName For Input As #FileNum Open itm 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) strTempFileName = Right(itm, 12) MsgBox "file = " & strTempFileName 'Show row number being imported on status bar. Application.StatusBar = "Importing Row " & _ Counter & " of text file " & itm 'Counter & " of text file " & FileName 'Store one line of text from file to variable. Line Input #FileNum, ResultStr 'Initialize the CommaCount variable to zero. CommaCount = 0 'Store the entire string into a second, temporary string. WorkResult = ResultStr 'Parse through the first line of data and separate out records '257 to 510. While CommaCount < 255 WorkResult = Right(WorkResult, Len(WorkResult) - InStr(1, WorkResult, ",")) CommaCount = CommaCount + 1 Wend 'Parse out any leading spaces. If Left(WorkResult, 1) = " " Then WorkResult = Right(WorkResult, Len(WorkResult) - 1) 'Ensure that any records that contain an "=" sign are 'brought in as text, and set the value of the current 'cell to the first 256 records. If Left(WorkResult, 1) = "=" Then ActiveCell.Value = "'" & Left(ResultStr, Len(ResultStr) - Len(WorkResult)) Else ActiveCell.Value = Left(ResultStr, Len(ResultStr) - Len(WorkResult)) End If 'Ensure that any records that contain an "=" sign are 'brought in as text,and set the value of the next cell 'to the last 256 records. If Left(WorkResult, 1) = "=" Then ActiveCell.Offset(0, 1).Value = "'" & WorkResult Else ActiveCell.Offset(0, 1).Value = WorkResult End If 'Move down one cell. ActiveCell.Offset(1, 0).Activate 'Increment the Counter by 1. Counter = Counter + 1 'start again at top of 'Do While' statement. Loop 'Close the open text file. Close 'Take records 257-510 and move them to sheet two. Columns("B:B").Select Selection.Cut Sheets("Sheet2").Select Columns("A:A").Select ActiveSheet.Paste Worksheets("sheet2").Range("iv:iv").Value = strTempFileName '<<<wrong..want it to put the filename in the last column of sheet2 for each record. ' .Visible = True '.Text = strtempfilename 'Run the text-to-columns wizard on both sheets. 'putting text to columns Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _ :=Array(Array(1, 1), Array(2, 1), Array(3, 1)) Sheets("Sheet1").Select Columns("A:A").Select Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _ :=Array(Array(1, 1), Array(2, 1), Array(3, 1)) 'Reset the application to its normal operating environment. Application.StatusBar = False Application.EnableEvents = True Application.ScreenUpdating = True Next Else Exit Sub End If End With Set fd = Nothing 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 Please help. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
macro problem: range offset question | Excel Discussion (Misc queries) | |||
Macro for Graph - problem with Range | Excel Programming | |||
Range R1C1 notation & the problem with my Macro | Excel Programming | |||
Problem with named range as VBA macro parameter | Excel Programming | |||
Excel Macro Problem, Add-in need to work in every workbook & Error:9 Subscript out of range | Excel Programming |