Loop with selection not working

[opazzo]

Hi there,

Here is my code, not working for some reasons I can't understand. Hope somebody here can.

What I am trying to do is copy files with filename based on cell value. I want to copy only those cells that I select. It is working fine if i select one cell at a time, but doesn't work when I select multiple cells. I believe there is something wrong with my loop.


<VB>

GetFolder ("c:/")
dest = dest + "/"

Col = ActiveCell.Column
Rw = ActiveCell.Row

If Col > 1 Then Exit Sub
If Rw < 6 Then Exit Sub

'set path
FPath = "\\shared drive\folder\"

For Each cell In Selection

'get file name from cell & adjust for formatting
ftx = cell.Offset(0, 6).Value
ftx = Right("00000" & ftx, 5)

'try to get the full path and name from the folder
FullName = FPath & ftx


fName = cell.Value
fName = Application.WorksheetFunction.Substitute(fName, "-", "")
fName = fName & "_" & ActiveCell.Offset(0, 1).Value & ".pdf"

'Search the file in FullName path
With Application.FileSearch
.NewSearch
.LookIn = FullName
.SearchSubFolders = False
.Filename = fName
If .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) > 0 Then
Fil = .FoundFiles(1)
Else
MsgBox "There were no files found"
Exit Sub
End If
End With

'and copy file(s)
FileCopy Fil, dest + fName

Next cell

eMsg = MsgBox("Files Copied. Please verify all files have been copied", vbInformation)

End Sub

Function GetFolder(strPath As String) As String
Dim fldr As FileDialog
Dim sItem As String
Dim sInitDir As String
sInitDir = CurDir ' Store initial directory
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
dest = sItem
End Function

</VB>

 

[CharlesChuckieCharles]

a single cell as a range is the default item of the selection

Dim mycell As Range


for each mycell in selection
...

next mycell


did you mean to look at the value in the cell 6 columns over

ftx = cell.Offset(0, 6).Value

also

instead of

fName = Application.WorksheetFunction.Substitute(fName, "-", "")

try
fName = Replace(fName, "-", "")

 

[opazzo]

Charles,

I confirm that I need to get one value from the cell 6 columns over to form part of my filename. And thanks for the replace function that I'll use instead of substitute.


Regarding my core problem OK for the Range, but if i filter my list, then my code will parse all cells, not only the visible ones. On the other hand if I change that to

For Each cell In Range("A6:A" & LastRow).SpecialCells(xlCellTypeVisible)

then my code will NOT work when I select a single cell... I can't really understand why...

Any ideas ?

 

[opazzo]

Can't find a way out of this.

In a filtered list I select some cells with the mouse and run a macro, but my loop keep on processing all cells in "selection", including those cells that are not visible, ie filtered and not selected.

I use the following
For Each cell In Selection
Next cell

Any ideas ? Should I replace Selection by something else like visible cells in selection ? Any help with the procedure is welcome

Thanks

 

[opazzo]

Anybody ?