Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
Copying cell values to a external file in VBA
Im looking for a piece of code which looks through cells and exports
the text in the cell into a .txt file. on each new row, column A must contain a 2, if not the macro stops. Also after every cell copied into the txt file, a comma needs to separate the values in the txt file. for example this is my data: A B C D E F 2 5977494A Shaw Ann 1943/06/18 45 Sarto Park 2 1613589R Nolan Mary 1945/10/31 4 Priory Grove St 2 6112747J Kennedy Harry 1946/02/12 50 Raheen Road so the txt file will look like: 2,5977494A,Shaw,Ann,1943/06/18,45 Sarto Park 2,1613589R,Nolan,Mary,1945/10/31,4 Priory Grove St 2,6112747J,Kennedy,Harry,1946/02/12,50 Raheen Road This is the code i have already, just cant seem to crack it! Sub Report_Body() Dim Cell_Loc As String Dim Cell_Num As Integer Dim Cell_Contents As String Dim Output As String newfname = "C:\Documents and Settings\mcragg\My Documents\Excel Reports\CWPS Folder\Record.txt" Open newfname For Output As #2 Cell_Contents = 2 Cell_Num = 2 Do While Cell_Contents = "2" Cell_Loc = "A" & Cell_Num Cell_Contents = Worksheets("Sheet1").Range(Cell_Loc).Value Output = Output & Cell_Contents Output = Output & "," Cell_Loc = "B" & Cell_Num Cell_Contents = Worksheets("Sheet1").Range(Cell_Loc).Value Output = Output & Cell_Contents Output = Output & "," Cell_Loc = "C" & Cell_Num Cell_Contents = Worksheets("Sheet1").Range(Cell_Loc).Value Output = Output & Cell_Contents Output = Output & "," Cell_Loc = "D" & Cell_Num Cell_Contents = Worksheets("Sheet1").Range(Cell_Loc).Value Output = Output & Cell_Contents Output = Output & "," Cell_Loc = "E" & Cell_Num Cell_Contents = Worksheets("Sheet1").Range(Cell_Loc).Value Output = Output & Cell_Contents Output = Output & "," Cell_Loc = "F" & Cell_Num Cell_Contents = Worksheets("Sheet1").Range(Cell_Loc).Value Output = Output & Cell_Contents Output = Output & "," Any help much appreciated Matt |
#2
Posted to microsoft.public.excel.misc
|
|||
|
|||
Copying cell values to a external file in VBA
One way of doing this would be to apply data|filter|autofilter to column A.
Then filter to show just the 2's. Select that range and copy to a worksheet in a new workbook and save this new workbook as a comma separated values file. But if you want code: Option Explicit Sub testme01() Dim wks As Worksheet Dim iRow As Long Dim FirstRow As Long Dim LastRow As Long Dim LastCol As Long Dim iCol As Long Dim myStr As String Dim NewFName As String Dim FileNum As Long NewFName = "C:\test.txt" Set wks = ActiveSheet With wks FirstRow = 2 LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row FileNum = FreeFile Close FileNum Open NewFName For Output As FileNum For iRow = FirstRow To LastRow If .Cells(iRow, "A").Value = 2 Then LastCol = .Cells(iRow, .Columns.Count).End(xlToLeft).Column myStr = "" For iCol = 1 To LastCol myStr = myStr & "," & .Cells(iRow, iCol).Text Next iCol myStr = Mid(myStr, 2) Print #FileNum, myStr End If Next iRow Close FileNum End With End Sub If you want to see some other sample code: Chip Pearson's: http://www.cpearson.com/excel/imptext.htm J.E. McGimpsey's: http://www.mcgimpsey.com/excel/textfiles.html DJ MC wrote: Im looking for a piece of code which looks through cells and exports the text in the cell into a .txt file. on each new row, column A must contain a 2, if not the macro stops. Also after every cell copied into the txt file, a comma needs to separate the values in the txt file. for example this is my data: A B C D E F 2 5977494A Shaw Ann 1943/06/18 45 Sarto Park 2 1613589R Nolan Mary 1945/10/31 4 Priory Grove St 2 6112747J Kennedy Harry 1946/02/12 50 Raheen Road so the txt file will look like: 2,5977494A,Shaw,Ann,1943/06/18,45 Sarto Park 2,1613589R,Nolan,Mary,1945/10/31,4 Priory Grove St 2,6112747J,Kennedy,Harry,1946/02/12,50 Raheen Road This is the code i have already, just cant seem to crack it! Sub Report_Body() Dim Cell_Loc As String Dim Cell_Num As Integer Dim Cell_Contents As String Dim Output As String newfname = "C:\Documents and Settings\mcragg\My Documents\Excel Reports\CWPS Folder\Record.txt" Open newfname For Output As #2 Cell_Contents = 2 Cell_Num = 2 Do While Cell_Contents = "2" Cell_Loc = "A" & Cell_Num Cell_Contents = Worksheets("Sheet1").Range(Cell_Loc).Value Output = Output & Cell_Contents Output = Output & "," Cell_Loc = "B" & Cell_Num Cell_Contents = Worksheets("Sheet1").Range(Cell_Loc).Value Output = Output & Cell_Contents Output = Output & "," Cell_Loc = "C" & Cell_Num Cell_Contents = Worksheets("Sheet1").Range(Cell_Loc).Value Output = Output & Cell_Contents Output = Output & "," Cell_Loc = "D" & Cell_Num Cell_Contents = Worksheets("Sheet1").Range(Cell_Loc).Value Output = Output & Cell_Contents Output = Output & "," Cell_Loc = "E" & Cell_Num Cell_Contents = Worksheets("Sheet1").Range(Cell_Loc).Value Output = Output & Cell_Contents Output = Output & "," Cell_Loc = "F" & Cell_Num Cell_Contents = Worksheets("Sheet1").Range(Cell_Loc).Value Output = Output & Cell_Contents Output = Output & "," Any help much appreciated Matt -- Dave Peterson |
#3
Posted to microsoft.public.excel.misc
|
|||
|
|||
Copying cell values to a external file in VBA
Hi, Matt-
I saw where you were going with the code, and rather than revise your code I thought I'd show an alernate way to write it- this is a touch more compact. Please note if you copy and paste this into your file: this newsgroup interface word-wraps, so longer lines of code that need to be on one line for the compiler may show up on multiple lines, and you'll need to remove line breaks. I wrote this code to match your description of the data's layout- for instance, the code should stop when it encounters a value in column A that is not a 2. What happens, though, if there is a blank line or another value that appears with more "2" rows below? Also, if you run this report on a daily basis you can modify the output filename via code to include a date and or timestamp. (Sorry if you knew that already.) Let us know what you think~ Dave O Sub Report_Body() Dim Output As String Range("a1").Select 'this assumes your data starts in cell A1 Open "C:\Documents and Settings\mcragg\My Documents\Excel Reports\CWPS Folder\Record.txt" For Output As #1 Do While InStr(1, ActiveCell.Value, "2") 0 'run when the entry in col A contains a 2 Output = ActiveCell.Value & "," & ActiveCell.Offset(0, 1).Value & "," & ActiveCell.Offset(0, 2).Value & "," & ActiveCell.Offset(0, 3).Value & "," & ActiveCell.Offset(0, 4).Value & "," & ActiveCell.Offset(0, 5).Value Print #1, Output ActiveCell.Offset(1, 0).Select Loop Close #1 Range("a1").Select Msgbox "Done." End Sub |
#4
Posted to microsoft.public.excel.misc
|
|||
|
|||
Copying cell values to a external file in VBA
Hi, Matt-
Not sure if I'm seeing a time lag with Google's newsgroup interface or if this message didn't post properly, so I'll post the code again. I got your expected results with this code: Sub Report_Body() Dim Output As String Range("a1").Select 'this assumes your data starts in cell A1 Open "C:\Documents and Settings\mcragg\My Documents\Excel Reports\CWPS Folder\Record.txt" For Output As #1 Do While InStr(1, ActiveCell.Value, "2") 0 'run when the entry in col A contains a 2 Output = ActiveCell.Value & "," & ActiveCell.Offset(0, 1).Value & "," & ActiveCell.Offset(0, 2).Value & "," & ActiveCell.Offset(0, 3).Value & "," & ActiveCell.Offset(0, 4).Value & "," & ActiveCell.Offset(0, 5).Value Print #1, Output ActiveCell.Offset(1, 0).Select Loop Close #1 End Sub |
#5
Posted to microsoft.public.excel.misc
|
|||
|
|||
Copying cell values to a external file in VBA
Cracked it!
Sub Report_Body() 'Builds record 2's for pensions interface Dim Cell_Loc As String Dim Cell_Num As Integer Dim Cell_Contents As String Dim Output As String Cell_Contents = 2 Cell_Num = 2 Do While Cell_Contents = "2" Output = "" Cell_Loc = "A" & Cell_Num Cell_Contents = Worksheets("Sheet1").Range(Cell_Loc).Value Output = Output & Cell_Contents Output = Output & "," Cell_Loc = "B" & Cell_Num Cell_Contents = Worksheets("Sheet1").Range(Cell_Loc).Value Output = Output & Cell_Contents Output = Output & "," Cell_Loc = "C" & Cell_Num Cell_Contents = Worksheets("Sheet1").Range(Cell_Loc).Value Output = Output & Cell_Contents Output = Output & "," Cell_Loc = "D" & Cell_Num Cell_Contents = Worksheets("Sheet1").Range(Cell_Loc).Value Output = Output & Cell_Contents Output = Output & "," Cell_Loc = "E" & Cell_Num Cell_Contents = Worksheets("Sheet1").Range(Cell_Loc).Value Output = Output & Cell_Contents Output = Output & "," Cell_Loc = "F" & Cell_Num Cell_Contents = Worksheets("Sheet1").Range(Cell_Loc).Value Output = Output & Cell_Contents Output = Output & "," Cell_Loc = "G" & Cell_Num Cell_Contents = Worksheets("Sheet1").Range(Cell_Loc).Value Output = Output & Cell_Contents Output = Output & "," Cell_Loc = "H" & Cell_Num Cell_Contents = Worksheets("Sheet1").Range(Cell_Loc).Value Output = Output & Cell_Contents Output = Output & "," Cell_Loc = "I" & Cell_Num Cell_Contents = Worksheets("Sheet1").Range(Cell_Loc).Value Output = Output & Cell_Contents Output = Output & "," Cell_Loc = "J" & Cell_Num Cell_Contents = Worksheets("Sheet1").Range(Cell_Loc).Value Output = Output & Cell_Contents Output = Output & "," Cell_Loc = "K" & Cell_Num Cell_Contents = Worksheets("Sheet1").Range(Cell_Loc).Value Output = Output & Cell_Contents Output = Output & "," Cell_Loc = "L" & Cell_Num Cell_Contents = Worksheets("Sheet1").Range(Cell_Loc).Value Output = Output & Cell_Contents Output = Output & "," Cell_Loc = "M" & Cell_Num Cell_Contents = Worksheets("Sheet1").Range(Cell_Loc).Value Output = Output & Cell_Contents Output = Output & "," Cell_Loc = "N" & Cell_Num Cell_Contents = Worksheets("Sheet1").Range(Cell_Loc).Value Output = Output & Cell_Contents Output = Output & "," Cell_Loc = "O" & Cell_Num Cell_Contents = Worksheets("Sheet1").Range(Cell_Loc).Value Output = Output & Cell_Contents Output = Output & "," Cell_Loc = "P" & Cell_Num Cell_Contents = Worksheets("Sheet1").Range(Cell_Loc).Value Output = Output & Cell_Contents Output = Output & "," Cell_Loc = "Q" & Cell_Num Cell_Contents = Worksheets("Sheet1").Range(Cell_Loc).Value Output = Output & Cell_Contents Output = Output & "," Cell_Loc = "R" & Cell_Num Cell_Contents = Worksheets("Sheet1").Range(Cell_Loc).Value Output = Output & Cell_Contents Output = Output & "," Cell_Loc = "S" & Cell_Num Cell_Contents = Worksheets("Sheet1").Range(Cell_Loc).Value Output = Output & Cell_Contents ' incroment counter by 1 and sets column two A ready for loop Cell_Num = Cell_Num + 1 Cell_Loc = "A" & Cell_Num Cell_Contents = Worksheets("Sheet1").Range(Cell_Loc).Value Print #1, Output Loop End Sub |
#6
Posted to microsoft.public.excel.misc
|
|||
|
|||
Copying cell values to a external file in VBA
See if this works for you:
Sub Report_Body() newfname = "C:\Documents and Settings\mcragg\My Documents\Excel Reports\CWPS Folder\Record.txt" Open newfname For Output As #2 rNum = 1 While CInt(Cells(rNum, 1)) = 2 outP = Cells(rNum, 2) For i = 3 To 6 outP = outP & "," & Cells(rNum, i) Next i 'outP = outP & Chr(10) Print #2, outP rNum = rNum + 1 Wend Close #2 End Sub Does this help? Kostis Vezerides |
#7
Posted to microsoft.public.excel.misc
|
|||
|
|||
Copying cell values to a external file in VBA
i think im getting a time lapse with google aswel, i dont see replies
until 3 hours after posted it seems. thanks for all your help ive added a bit of your codes to mine and found it easier to run :) thanks again Matt |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Saving worksheet in new file with date AND cell value as file name | Excel Discussion (Misc queries) | |||
Help with this conditional IF statement | Excel Discussion (Misc queries) | |||
resetting last cell | Excel Discussion (Misc queries) | |||
Save External Link Values | Excel Discussion (Misc queries) | |||
Using Jet to read excel file returns blank for last cell - sometim | Excel Discussion (Misc queries) |