technician12
12-17-2018, 06:38 AM
Hello.
anyone here willing to assist me with changing a formula to apply to more than 1 cell.
see picture for more understanding.
i know i can repeat this formula in a new module for every line ( but i also know this is a very inefficient way of doing it :) )
:
Sub MoveFile()
'Graham Mayor - https://www.gmayor.com - Last updated - 30 Nov 2018
Dim fso As Object
Dim iPath As Long
Dim vPath As Variant
Dim strPath As String, strOldPath As String
Dim strName As String
Dim xlSheet As Worksheet
Set xlSheet = ActiveSheet
With xlSheet
strPath = .Range("B7") & "\Approved" 'assign the target path to a string
If UCase(.Range("I3")) = "YES" Then 'check if the move is approved
Set fso = CreateObject("Scripting.FileSystemObject")
strOldPath = .Range("E3") 'assign the original file path to a string
If fso.FileExists(strOldPath) Then
'extract the filename from the full name
strName = Split(strOldPath, "")(UBound(Split(strOldPath, "")))
'ensure the target path exists and create it if it doesn't
vPath = Split(strPath, "")
strPath = vPath(0) & ""
For iPath = 1 To UBound(vPath)
strPath = strPath & vPath(iPath) & ""
If Not fso.FolderExists(strPath) Then MkDir strPath
Next iPath
'move the file
Name strOldPath As strPath & strName
Beep
MsgBox "File moved to " & strPath
Else
Beep
MsgBox strOldPath & " not found"
End If
End If
End With
Set xlSheet = Nothing
Set fso = Nothing
Range("I3").Select
ActiveWindow.SmallScroll Down:=27
Range("I3:I61").Select
ActiveWindow.SmallScroll Down:=-39
Selection.ClearContents
Range("A1").Select
Range("B7").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End Sub
:
anyone here willing to assist me with changing a formula to apply to more than 1 cell.
see picture for more understanding.
i know i can repeat this formula in a new module for every line ( but i also know this is a very inefficient way of doing it :) )
:
Sub MoveFile()
'Graham Mayor - https://www.gmayor.com - Last updated - 30 Nov 2018
Dim fso As Object
Dim iPath As Long
Dim vPath As Variant
Dim strPath As String, strOldPath As String
Dim strName As String
Dim xlSheet As Worksheet
Set xlSheet = ActiveSheet
With xlSheet
strPath = .Range("B7") & "\Approved" 'assign the target path to a string
If UCase(.Range("I3")) = "YES" Then 'check if the move is approved
Set fso = CreateObject("Scripting.FileSystemObject")
strOldPath = .Range("E3") 'assign the original file path to a string
If fso.FileExists(strOldPath) Then
'extract the filename from the full name
strName = Split(strOldPath, "")(UBound(Split(strOldPath, "")))
'ensure the target path exists and create it if it doesn't
vPath = Split(strPath, "")
strPath = vPath(0) & ""
For iPath = 1 To UBound(vPath)
strPath = strPath & vPath(iPath) & ""
If Not fso.FolderExists(strPath) Then MkDir strPath
Next iPath
'move the file
Name strOldPath As strPath & strName
Beep
MsgBox "File moved to " & strPath
Else
Beep
MsgBox strOldPath & " not found"
End If
End If
End With
Set xlSheet = Nothing
Set fso = Nothing
Range("I3").Select
ActiveWindow.SmallScroll Down:=27
Range("I3:I61").Select
ActiveWindow.SmallScroll Down:=-39
Selection.ClearContents
Range("A1").Select
Range("B7").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End Sub
: