Condense this code ?

[khalid79m]

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]

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]

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]

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]

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]

How do I get it to only save if the file doesnt alreay exsist ?

[mdmackillop]

Change the SaveAs line to


If Dir(path & Range(str)) = "" Then ActiveWorkbook.SaveAs Filename:=path & Range(str)

[khalid79m]

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]

: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]

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