PDA

View Full Version : Solved: condense this code ?



khalid79m
03-13-2007, 04:08 PM
Sub CFD()

Range("A2").Select
If Range("A2") <> "" Then
ActiveWorkbook.SaveAs Filename:= _
"P:\CET - e\TL Monthly Reports\TL Reports\" & Range("A2").Value
End If

Range("A3").Select
If Range("A3") <> "" Then
ActiveWorkbook.SaveAs Filename:= _
"P:\CET - e\TL Monthly Reports\TL Reports\" & Range("A3").Value
End If

Range("A4").Select
If Range("A4") <> "" Then
ActiveWorkbook.SaveAs Filename:= _
"P:\CET - e\TL Monthly Reports\TL Reports\" & Range("A4").Value
End If

Range("A5").Select
If Range("A5") <> "" Then
ActiveWorkbook.SaveAs Filename:= _
"P:\CET - e\TL Monthly Reports\TL Reports\" & Range("A5").Value
End If

Range("A6").Select
If Range("A6") <> "" Then
ActiveWorkbook.SaveAs Filename:= _
"P:\CET - e\TL Monthly Reports\TL Reports\" & Range("A6").Value
End If

End Sub

I am continuing on from the guy who used to do this job before and this code above runs all the way to a1000 and it looks like the previous guys has just repeated the above again and again . is there anyway to just make this run until it hits a blank cell in coloum A.:devil2:

mdmackillop
03-13-2007, 04:50 PM
Hi Khalid
Welcome to VBAX
Try the following. The first will skip over blanks; the second will stop at the first blank.

Sub CFD()
Dim cel as Range
For Each cel In Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
If cel <> "" Then
ActiveWorkbook.SaveAs Filename:= _
"P:\CET - e\TL Monthly Reports\TL Reports\" & cel.Value
End If
Next
End Sub


or

Sub CFD2()
Dim cel as Range
For Each cel In Range(Cells(2, 1), Cells(2, 1).End(xlDown))
ActiveWorkbook.SaveAs Filename:= _
"P:\CET - e\TL Monthly Reports\TL Reports\" & cel.Value
Next
End Sub

malik641
03-13-2007, 10:22 PM
I am continuing on from the guy who used to do this job before and this code above runs all the way to a1000 and it looks like the previous guys has just repeated the above again and again . is there anyway to just make this run until it hits a blank cell in coloum A.:devil2:

Oh my God, that poor guy made 1000 repeated blocks of code? Wow, I feel bad for him. Just a little more knowledge would have helped him 1000x.

ambassadeur
03-14-2007, 08:35 AM
Could you try this :

dim i as integer
dim str, path as string

i = 2
str "A2"
path = "P:\CET - e\TL Monthly Reports\TL Reports\"
While Range(str) <> ""
Range(str).select
ActiveWorkbook.SaveAs Filename:= path & str

' next one
i = i+1
str = "A" & i

wend

mdmackillop
03-14-2007, 09:51 AM
Hi Ambassadeur
Try to avoid selecting. It slows down the code and is almost never necessary.
Also, use Long instead of Integer. It's more efficient and you could exceed the limits of Integer (32767) with spreadsheet rows.
Declare your variables separately, Dim str, path as String only dims path. str is dimmed as Variant.

Amending your method to avoid selection gives

Dim i As Integer
Dim str as String, path As String
i = 2
str = "A2"
path = "P:\CET - e\TL Monthly Reports\TL Reports\"
While Range(str) <> ""
str = "A" & i
ActiveWorkbook.SaveAs Filename:=path & Range(str)
i = i + 1
Wend

khalid79m
03-14-2007, 01:25 PM
How do I get it to only save if the file doesnt alreay exsist ?

mdmackillop
03-14-2007, 02:30 PM
Change the SaveAs line to
If Dir(path & Range(str)) = "" Then ActiveWorkbook.SaveAs Filename:=path & Range(str)

khalid79m
03-14-2007, 02:58 PM
Sub CFD()
Dim cel As Range
For Each cel In Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
If cel <> "" Then
ActiveWorkbook.SaveAs Filename:= _
"P:\CET - e\TL Monthly Reports\TL Reports\" & cel.Value
End If
Next
End Sub

is the best script as the first response you did only worked the remaining after that didnt.

so i just change the line

ActiveWorkbook.SaveAs Filename:= _
"P:\CET - e\TL Monthly Reports\TL Reports\" & cel.Value
?

khalid79m
03-14-2007, 03:09 PM
:help I tried the code amendment with the last scirpt you sent and it doesnt work, it comes up the file already exisit would you like to replace it#?

mdmackillop
03-14-2007, 03:22 PM
Apologies. I confused my reply to you and my response to Ambassadeur.

Sub CFD()
Dim cel As Range, FName As String
For Each cel In Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
If cel <> "" Then
FName = "P:\CET - e\TL Monthly Reports\TL Reports\" & cel.Value
If Dir(FName) = "" Then ActiveWorkbook.SaveAs Filename:=FName
End If
Next
End Sub