user1810449
user1810449

Reputation: 173

vba looping through range writing to csv

I have written this macro it is supposed to loop through a range and if that range contains a number then copy the offset cells into a csv or to another sheet. Currently when i excute the code it runs through with out breaking however there is no output within my text file nor are there any error messages.

I dont know what is going on? any pointers? please help thanks.

Dim rng As Range, cell As Range 
Dim ofset As String 
Dim filepath As String 

Set rng = Range("F1:F100") 

For Each cell In rng 
  If IsError(cell) Then 
    'MsgBox "cell " & cell.Address & " contains error" 
  ElseIf cell.Value > 0 Then 
    ofset = cell.Offset(, -2).Resize(, 2).Select 'gives you B1:C1 
    ' copy this range to text file 
    filepath = Application.DefaultFilePath & "\authors.csv" 
    Open filepath For Output As #2 

    Write #2, cell.Value & ofset 
    Close #2 

  End If
Next cell
MsgBox "The values have been copied"

Upvotes: 0

Views: 1541

Answers (2)

Jimmy Smith
Jimmy Smith

Reputation: 2451

Is the file date updated on each pass?

There may be a null string at the end of the data. If you're not wanting to only get the last value, change this:

Open filepath For Output As #2 

to

Open filepath For Append As #2 

Dim rng As Range, cell As Range  Dim ofset As String  Dim filepath As String 

Set rng = Range("F1:F100") 

For Each cell In rng    If IsError(cell) Then 
    'MsgBox "cell " & cell.Address & " contains error"    ElseIf cell.Value > 0 Then 
    ofset = cell.Offset(, -2).Resize(, 2).Select 'gives you B1:C1 
    ' copy this range to text file 
    filepath = Application.DefaultFilePath & "\authors.csv" 
    Open filepath For Output As #2 

    oValues = ""
    For each c in ofset
      oValues=Ovalues & c.value
    next

    Write #2, cell.Value & oValues
    Close #2 

  End If 
Next cell 

MsgBox "The values have been copied"

Upvotes: 1

user1810449
user1810449

Reputation: 173

This code below seems to copy the offset cell VALUES into the CSV. It gives the desired result. For now this will suffice however I am going to look for a way to take the values and put them in individual columns.

  Sub Test3()
Dim rng As Range, cell As Range
Dim ofset As String
Dim filepath As String

Set rng = Range("F1:F100")

For Each cell In rng
If IsError(cell) Then
'MsgBox "cell " & cell.Address & " contains error"
ElseIf cell.Value > 0 Then
   cell.Offset(, -2).Resize(, 2).Select 'gives you B1:C1
' copy this range to text file
filepath = "C:\Users\Jabaar\Documents\authors.csv"
Open filepath For Append As #2

    Write #2, cell.Value & " " & cell.Offset(, -2).Value & " " & cell.Offset(, -4).Value
Close #2

End If
    Next cell
    MsgBox "The data has been collected"
End Sub

Upvotes: 0

Related Questions