Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
 
Posts: 14
Default 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   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
 
Posts: 35,218
Default 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   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
 
Posts: 427
Default 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   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
 
Posts: 427
Default 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   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
 
Posts: 14
Default 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   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
 
Posts: 751
Default 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   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
 
Posts: 14
Default 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
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Saving worksheet in new file with date AND cell value as file name michaelberrier Excel Discussion (Misc queries) 4 May 26th 06 08:05 PM
Help with this conditional IF statement C-Dawg Excel Discussion (Misc queries) 3 May 15th 06 06:01 PM
resetting last cell jagdish.eashwar Excel Discussion (Misc queries) 11 March 31st 06 02:06 AM
Save External Link Values Stephane Excel Discussion (Misc queries) 0 January 3rd 05 12:01 PM
Using Jet to read excel file returns blank for last cell - sometim Ron Excel Discussion (Misc queries) 1 December 9th 04 09:21 AM


All times are GMT +1. The time now is 02:17 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"