Save Excel 2007 Data Range to a CSV file

I have the following VBA code.

Sub ExportRange()
Dim FirstCol As Integer
Dim LastCol As Integer
Dim C As Integer
Dim FirstRow
Dim LastRow
Dim R
Dim data
Dim ExpRng As Range
Sheets("AddrFilt").Select

Range("L1").Select
    Set ExpRng = ActiveCell.CurrentRegion
    FirstCol = ExpRng.Columns(1).Column
    LastCol = FirstCol + ExpRng.Columns.Count - 1
    FirstRow = ExpRng.Rows(1).Row
    LastRow = FirstRow + ExpRng.Rows.Count - 1

    Open ThisWorkbook.Path & "C:\Users\Glen\Documents\PMC\NHSN_Data.csv" For Output As #1 ' csv file
    '''''''Open ThisWorkbook.Path & "\textfile.txt" For Output As #1 '''''or txt file
        For R = FirstRow To LastRow
            For C = FirstCol To LastCol
                data = ExpRng.Cells(R, C).Value
                If data = "" Then data = ""
                If IsNumeric(data) Then data = Val(data)
                If C <> LastCol Then
                    Write #1, data;
                Else
                    Write #1, data
                End If
            Next C
        Next R
    Close #1
End Sub


 The goal is to export the data in Col L through Col R.  Row 1 has headers,  It should stop copying data when it reaches a record with:

#VALUE!      #VALUE!      #N/A      #N/A      #N/A      #N/A      #VALUE!


First how can I write a Do While Not  loop to stop at the first invalid record.
Second, I get a Bad File Name or Number error for the Open  ThisWorkbook.Path statement..

Thanks

Glen
GPSPOWAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

SteveCommented:
Firstly:

Open ThisWorkbook.Path & "C:\Users\Glen\Documents\PMC\NHSN_Data.csv" For Output As 

Open in new window


This will read as "C:\Users\Glen\Documents\PMCC:\Users\Glen\Documents\PMC\NHSN_Data.csv" for the file path... this should be either:
Open ThisWorkbook.Path & "\NHSN_Data.csv" For Output As

Open in new window

or
Open "C:\Users\Glen\Documents\PMC\NHSN_Data.csv" For Output As

Open in new window

0
SteveCommented:
Then you have the issue of the looping:
testing the first Column for each Row for ISERROR should do it.
       For R = FirstRow To LastRow
            if iserror(ExpRng.Cells(R, FirstCol).Value) then exit for 'added error test
            For C = FirstCol To LastCol
                data = ExpRng.Cells(R, C).Value
                If data = "" Then data = ""
                If IsNumeric(data) Then data = Val(data)
                If C <> LastCol Then
                    Write #1, data;
                Else
                    Write #1, data
                End If
            Next C
        Next R

Open in new window

0
GPSPOWAuthor Commented:
Here is code after I made the above suggestions:

Sub ExportRange()
Dim FirstCol As Integer
Dim LastCol As Integer
Dim C As Integer
Dim FirstRow
Dim LastRow
Dim R
Dim data
Dim ExpRng As Range
Sheets("AddrFilt").Select

Range("L1").Select
    Set ExpRng = ActiveCell.CurrentRegion
    FirstCol = ExpRng.Columns(1).Column
    LastCol = FirstCol + ExpRng.Columns.Count - 1
    FirstRow = ExpRng.Rows(1).Row
    LastRow = FirstRow + ExpRng.Rows.Count - 1


Open "C:\Users\Glen\Documents\PMC\NHSN_Data.csv" For Output As #1
    'Open ThisWorkbook.Path & "C:\Users\Glen\Documents\PMC\NHSN_Data.csv" For Output As #1 ' csv file
    '''''''Open ThisWorkbook.Path & "\textfile.txt" For Output As #1 '''''or txt file
       
For R = FirstRow To LastRow
            If IsError(ExpRng.Cells(R, 1).Value) Then Exit For 'added error test
            For C = FirstCol To LastCol
                data = ExpRng.Cells(R, C).Value
                If data = "" Then data = ""
                If IsNumeric(data) Then data = Val(data)
                If C <> LastCol Then
                    Write #1, data;
                Else
                    Write #1, data
                End If
            Next C
        Next R
    Close #1
End Sub


Here is a sample of my data with the headers:

FirstName      Last Name      Address      City      State      PostalCode      Title
LARRY      ALEXANDER      5125 FAIRMONT PKWY      PASADENA      TX      77505      MD
NATARAJAN      BALA      444 FM 1959      HOUSTON      TX      77034      MD
BERNARD BRIAN      BRADLEY      4003 WOODLAWN AVE      PASADENA      TX      77504      MD
SATHISH      CAYENNE      4004 WOODLAWN AVE      PASADENA      TX      77504      MD
NIZAR      CHARAFEDDINE      2813 SMITH RANCH ROAD      PEARLAND      TX      77584      MD
#VALUE!      #VALUE!      #N/A      #N/A      #N/A      #N/A      #VALUE!


I getting a Data Type Mismatch at this line:


 If data = "" Then data = ""

Any suggestions?

Thanks

Glen
0
Newly released Acronis True Image 2019

In announcing the release of the 15th Anniversary Edition of Acronis True Image 2019, the company revealed that its artificial intelligence-based anti-ransomware technology – stopped more than 200,000 ransomware attacks on 150,000 customers last year.

SteveCommented:
If you could try this bit of code...
May do what you require:
Option Explicit
Sub ExportRange()

Dim C As Integer
Dim LastRow
Dim R As Long
Dim data

LastRow = Sheets("AddrFilt").Range("L65526").End(xlUp).Row
'Open ThisWorkbook.Path & "\NHSN_Data.csv" For Output As #1
Open "C:\Users\Glen\Documents\PMC\NHSN_Data.csv" For Output As #1
   
For R = 1 To LastRow
    If Not IsError(Sheets("AddrFilt").Cells(R, 12)) Then 'added error test
        For C = 1 To 7
                data = Sheets("AddrFilt").Cells(R, C + 11).Value
                If Len(data) = 0 Then data = ""
                If IsNumeric(data) Then data = Val(data)
                If C <> 7 Then
                    Write #1, data;
                Else
                    Write #1, data
                End If
        Next C
    End If
Next R
Close #1

End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
GPSPOWAuthor Commented:
Thank you

It worked perfectly.
0
SteveCommented:
You are welcome, anytime.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Applications

From novice to tech pro — start learning today.