Reputation: 173
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
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
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