Save range as a new file?

[Ago]

I have a add-in macro file that runs when i open a csv-file.
The macro removes useless data (and some other stuff), but now i have found a use for that useless data.
But i need that data split in three files.

Is there any way that i can use something like Range(rng).SaveAs ?
Lets call them rng1, rng2 and rng3.

Can i save rng1 as a new csv file called airplane.csv
rng2 as freefall.csv
and rng3 as canopy.csv?

All ranges are ~50-75 rows and two columns if that makes any difference.

Can this be done without having to open a new document, copy paste, save, and close three times?
The main reason is the time and that it will be lots of "funny stuff" happening on screen.

I post the code i have here if its of any help:

Public WithEvents App As Application

Private Sub App_SheetActivate(ByVal Sh As Object)


Dim A As Double
Dim wkbName As String
wkbName = Application.Workbooks(1).Name
extension = Mid(wkbName, InStr(wkbName, "."))

If extension = ".csv" And Range("A1").Value = "LATITUDE" And Range("B1").Value = "LONGITUDE" _
And Range("C1").Value = "ALTITUDE" And Range("D1").Value = "SPEED" Then
Response = MsgBox(prompt:="Run GPS-Script?", Buttons:=vbYesNo)
If Response = vbNo Then
Exit Sub
End If
Else
Exit Sub
End If


Columns(1).Insert
Rows(2).Insert
Rows(2).Insert
Rows(2).Insert

LastRow = Range("B" & Rows.Count).End(xlUp).Row

Range("B5", "E" & LastRow).NumberFormat = "@"
For Each Dcell In Range("B5", "E" & LastRow)
A = Replace(Dcell.Value, ".", ",")
Dcell.Value = A
Next

Columns(4).Insert
Range("D:D").NumberFormat = "0"
Range("D6").Value = "=ACOS(COS(RADIANS(90-B5)) *COS(RADIANS(90-B6)) _
+SIN(RADIANS(90-B5)) *SIN(RADIANS(90-B6)) *COS(RADIANS(C5-C6))) *6371000"
Range("D7").Value = "=D6+ACOS(COS(RADIANS(90-B6)) *COS(RADIANS(90-B7)) _
+SIN(RADIANS(90-B6)) *SIN(RADIANS(90-B7)) *COS(RADIANS(C6-C7))) *6371000"
Range("D7", "D" & LastRow).FillDown

Columns(6).Insert
Range("E:G").NumberFormat = "0"
Range("F6").Value = "=((E5-E6)/1000)*60*60"
Range("F6", "F" & LastRow).FillDown

Columns(8).Insert
Range("H:H").NumberFormat = "0"
Range("H6").Value = "=SQRT(F6*F6+G6*G6)"
Range("H6", "H" & LastRow).FillDown

Columns(9).Insert
Range("I:I").NumberFormat = "0.000"
Range("I6").Value = "=G6/F6"
Range("I6", "I" & LastRow).FillDown

Range("J:J").TextToColumns Destination:=Range("J1"), DataType:=xlDelimited, _
Other:=True, OtherChar:="Z"
Range("J:J").TextToColumns Destination:=Range("J1"), DataType:=xlDelimited, _
Other:=True, OtherChar:="T"
Range("A1", "L1").ClearContents
Range("B1").Value = "Latitude"
Range("C1").Value = "Longitude"
Range("D1").Value = "H-Distance"
Range("E1").Value = "Altitude"
Range("F1").Value = "V-Speed"
Range("G1").Value = "H-Speed"
Range("H1").Value = "3D-Speed"
Range("I1").Value = "Glide"
Range("J1").Value = "Date"
Range("K1").Value = "Time"
Range("A2").Value = "Max"
Range("A3").Value = "Min"
Range("A4").Value = "Avg"

For i = 120 To LastRow
If Range("F" & i).Value < 100 And Range("E" & i).Value < 2000 Then
Exit For
End If
If Range("F" & i).Value > 100 And (Minute(Range("K" & i).Value) - Minute(Range("K" & i - 1).Value)) * 60 _
+ Second(Range("K" & i).Value) - Second(Range("K" & i - 1).Value) < 2 And j = "" Then
j = i
End If
If Range("E" & i).Value < 1400 And FreefallEnd = "" Then
FreefallEnd = i
End If
If Range("F" & i).Value > 160 And Range("F" & i).Value < 300 And Range("F" & i + 1).Value > 160 _
And FreefallStart = "" Then
FreefallStart = i
End If
Next i

Range(Cells(i + 8, 1), Cells(LastRow, 1)).EntireRow.Delete
Range(Cells(5, 1), Cells(j - 11, 1)).EntireRow.Delete
FreefallEnd = FreefallEnd - j + 15
FreefallStart = FreefallStart - j + 15

Rows("5:5").Select
ActiveWindow.FreezePanes = True
Range("A1").Select
Cells.Columns.AutoFit

Range("F5").ClearContents
Range("H5", "I5").ClearContents
Range("D5", "D9").Value = "0"

Range("D2").Value = Range("D" & FreefallEnd).Value
Range("F2").Value = "=MAX(F" & FreefallStart & ":F" & FreefallEnd & ")"
Range("F3").Value = "=MIN(F" & FreefallStart & ":F" & FreefallEnd & ")"
Range("F4").Value = "=AVERAGE(F" & FreefallStart & ":F" & FreefallEnd & ")"
Range("G2").Value = "=MAX(G" & FreefallStart & ":G" & FreefallEnd & ")"
Range("G3").Value = "=MIN(G" & FreefallStart & ":G" & FreefallEnd & ")"
Range("G4").Value = "=AVERAGE(G" & FreefallStart & ":G" & FreefallEnd & ")"
Range("H2").Value = "=MAX(H" & FreefallStart & ":H" & FreefallEnd & ")"
Range("H3").Value = "=MIN(H" & FreefallStart & ":H" & FreefallEnd & ")"
Range("H4").Value = "=AVERAGE(H" & FreefallStart & ":H" & FreefallEnd & ")"
Range("I2").Value = "=MAX(I" & FreefallStart & ":I" & FreefallEnd & ")"
Range("I3").Value = "=MIN(I" & FreefallStart & ":I" & FreefallEnd & ")"
Range("I4").Value = "=AVERAGE(I" & FreefallStart & ":I" & FreefallEnd & ")"
End Sub

' Initiation of App object
Private Sub Workbook_Open()
Set App = Application
End Sub

[mdmackillop]

You can create at text file and write the data to it.
Help example
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("c:\testfile.txt", True)
a.WriteLine("This is a test.")
a.Close

[Ago]

I get 'Permission denied' runtime error 70 on the line createtextfile.

If it works that might be a good solution

EDIT: my bad, C is protected in win vista

[mdmackillop]

Try creating the file in a subfolder. It's a windows thing; VBA will not create a file on the root directory in Vista onwards

[Ago]

Yes, thanks i rememberd that too late.

Now i got to the next line
A.WriteLine (Range("B" & 296, "C" & 246).Value)
I just used those cells as testobjects but i get a type mismatch.
Is that because the writeline wants me to type one line at the time?

[mdmackillop]

Yes. You may also wish to add a vbTab or comma between terms

[Ago]

Yes. You may also wish to add a vbTab or comma between terms

Hmm. So that means i have to loop trough those 150 lines (50 x 3).

What do you mean with the comma or vbTab part?

[mdmackillop]

You're writing to a text file. You may need to split the values to reopen in Excel.
If not, no problem.

[Ago]

Since i dont want to loop it i guess my only choise is to create a new sheet and copy paste and save that sheet.
I think it can be done quicker than looping.

[Ago]

What am i doing wrong here?

Range("B" & j - 54, "C" & j - 4).Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:=wkbPath & wkbPath2 & "Plane.csv", FileFormat:=xlCSV
Workbooks(2).Activate
Sheet1.Cells.Clear

Workbooks(1).Activate
Range("B" & j - 4, "C" & i + 3).Copy
Workbooks(2).Activate
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:=wkbPath & wkbPath2 & "Freefall.csv", FileFormat:=xlCSV
Workbooks(2).Activate
Sheet1.Cells.Clear

Workbooks(1).Activate
Range("B" & i + 3, "C" & LastRow).Copy
Workbooks(2).Activate
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:=wkbPath & wkbPath2 & "Canopy.csv", FileFormat:=xlCSV
Workbooks(2).Activate
ActiveWindow.Close


It clears the cells of the wrong workbook

[mdmackillop]

Why not add the workbook reference in front to avoid errors
Workbooks(1).Sheet1.Cells.Clear

BTW, if you are repeating code actions, consider passing data to a second routine to to the repeating task. It's easier to debug and maintain



Option Explicit

Const wkbPath = "C:\"
Const wkbPath2 = "Test\"

Sub DoStuff()
Dim i%, j%, LastRow%
Call DoMoreStuff(Range("B" & j - 54, "C" & j - 4), "Plane")
Call DoMoreStuff(Range("B" & j - 4, "C" & i + 3), "FreeFall")
Call DoMoreStuff(Range("B" & i + 3, "C" & LastRow), "Canopy")
End Sub

Sub DoMoreStuff(Rng As Range, FName)
Sheets.Add
With ActiveSheet
.Paste
.Move
End With
Application.DisplayAlerts = False
With ActiveWorkbook
.SaveAs Filename:=wkbPath & wkbPath2 & FName & ".csv", FileFormat:=xlCSV
.Close
End With
Application.DisplayAlerts = True

End Sub

[Ago]

Why not add the workbook reference in front to avoid errors
Workbooks(1).Sheet1.Cells.Clear

BTW, if you are repeating code actions, consider passing data to a second routine to to the repeating task. It's easier to debug and maintain



Option Explicit

Const wkbPath = "C:\"
Const wkbPath2 = "Test\"

Sub DoStuff()
Dim i%, j%, LastRow%
Call DoMoreStuff(Range("B" & j - 54, "C" & j - 4), "Plane")
Call DoMoreStuff(Range("B" & j - 4, "C" & i + 3), "FreeFall")
Call DoMoreStuff(Range("B" & i + 3, "C" & LastRow), "Canopy")
End Sub

Sub DoMoreStuff(Rng As Range, FName)
Sheets.Add
With ActiveSheet
.Paste
.Move
End With
Application.DisplayAlerts = False
With ActiveWorkbook
.SaveAs Filename:=wkbPath & wkbPath2 & FName & ".csv", FileFormat:=xlCSV
.Close
End With
Application.DisplayAlerts = True

End Sub



Good point about the routine, i was first trying to make it work then i would consider doing those things.

It works as long as i use it as a modulcode, but once i make it a add-in it adds the sheet to the wrong workbook therefore crahsing at .with paste

I attached the work so far.
The GPS.xlam file should be in (vista) C:\Users\<<<USER>>>\AppData\Roaming\Microsoft\AddIns\ folder.
and the csv-file can be placed anywhere but you need to create a subfolder called 20100424_1409 where you place the csv-file.
i havnt botherd automating that part yet, still need to get things working first.

The problem is that it creates new sheets on the gps.xlam file, not the 20100424_1409.csv file, therefore activesheet is empty.
If i try workbooks(1).activate, it will activate the csv-file, but the sheet will still be created in the wrong file.:banghead:

Thank you very much for your help so far!