ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   File Location Based on Cell Reference (https://www.excelbanter.com/excel-programming/410404-file-location-based-cell-reference.html)

Monk[_2_]

File Location Based on Cell Reference
 
I have a worksheet cell (say a1) with values such as Paul, David, Mark etc.

What I am struggling with is to develop a macro which will use the data in
that cell to determine the location the file will be saved to when the macro
is run.

i.e If a1= Paul, the file location will be F:/Paul's Directory/Filename.xls
If a1 = Mark, the file location will be F:/Mark's Directory/Filename.xls

Any suggestions would be appreciated.

Norman Jones[_2_]

File Location Based on Cell Reference
 
Hi Monk,

In a standard module, try something like:

'===========
Public Sub aTester()
Dim WB As Workbook
Dim SH As Worksheet
Dim Rng As Range
Dim arrNames As Variant
Dim arrFolders As Variant
Dim Res As Variant
Dim sStr As String
Const sName As String = "MyFile" '<<=== CHANGE
Const sElseFolder As String = _
"C:\Users\Other\" '<<=== CHANGE

arrFolders = VBA.Array("C:\Users\Paul\", _
"C:\Users\Mark\", _
"C:\Users\Joe") '<<=== CHANGE

arrNames = VBA.Array("Paul", _
"Mark", _
"Joe") '<<=== CHANGE

Set WB = ActiveWorkbook '<<=== CHANGE

With WB
Set SH = .Sheets("heet1") '<<=== CHANGE
Set Rng = Sh.Range("A1") '<<=== CHANGE

Res = Application.Match(Rng.Value, arrNames, 0)

If IsError(Res) Then
sStr = sElseFolder
Else
sStr = arrFolders(Res - 1)
End If

.SaveAs Filename:=sStr & .Name & ".xls", _
FileFormat:=xlWorkbookNormal
End With

End Sub
'<<===========

Note that the constant sElseFolder value is
provided to allow for the case in which an
unrecognised (or empty) value is enterd in the
cell of interest.

As an alternative, you might consider replacing
the arrays with a Select Case construct - see
VBA help for details, or post back.



---
Regards.
Norman


"Monk" wrote in message
...
I have a worksheet cell (say a1) with values such as Paul, David, Mark etc.

What I am struggling with is to develop a macro which will use the data in
that cell to determine the location the file will be saved to when the
macro
is run.

i.e If a1= Paul, the file location will be F:/Paul's
Directory/Filename.xls
If a1 = Mark, the file location will be F:/Mark's Directory/Filename.xls

Any suggestions would be appreciated.



Monk[_2_]

File Location Based on Cell Reference
 
Thanks Norman

I was hoping there may be something less complex. The following code is part
of an existing module and I was hoping it could pick up the value of cell A1
(i.e say value = Paul) and enter this in the directory so it would save as
F:\Home\Paul\Trading\2.Draft Trades.xls. If A1 had a value of Mike it would
save as F:\Home\Mike\Trading\2.Draft Trades.xls. Can the below be modified
simply?

fileSaveName = Application.GetSaveAsFilename("F:\Home\Cell
A1\Trading\2.Draft Trades.xls", _
"Excel Files (*.xls), *.xls")


"Norman Jones" wrote:

Hi Monk,

In a standard module, try something like:

'===========
Public Sub aTester()
Dim WB As Workbook
Dim SH As Worksheet
Dim Rng As Range
Dim arrNames As Variant
Dim arrFolders As Variant
Dim Res As Variant
Dim sStr As String
Const sName As String = "MyFile" '<<=== CHANGE
Const sElseFolder As String = _
"C:\Users\Other\" '<<=== CHANGE

arrFolders = VBA.Array("C:\Users\Paul\", _
"C:\Users\Mark\", _
"C:\Users\Joe") '<<=== CHANGE

arrNames = VBA.Array("Paul", _
"Mark", _
"Joe") '<<=== CHANGE

Set WB = ActiveWorkbook '<<=== CHANGE

With WB
Set SH = .Sheets("heet1") '<<=== CHANGE
Set Rng = Sh.Range("A1") '<<=== CHANGE

Res = Application.Match(Rng.Value, arrNames, 0)

If IsError(Res) Then
sStr = sElseFolder
Else
sStr = arrFolders(Res - 1)
End If

.SaveAs Filename:=sStr & .Name & ".xls", _
FileFormat:=xlWorkbookNormal
End With

End Sub
'<<===========

Note that the constant sElseFolder value is
provided to allow for the case in which an
unrecognised (or empty) value is enterd in the
cell of interest.

As an alternative, you might consider replacing
the arrays with a Select Case construct - see
VBA help for details, or post back.



---
Regards.
Norman


"Monk" wrote in message
...
I have a worksheet cell (say a1) with values such as Paul, David, Mark etc.

What I am struggling with is to develop a macro which will use the data in
that cell to determine the location the file will be saved to when the
macro
is run.

i.e If a1= Paul, the file location will be F:/Paul's
Directory/Filename.xls
If a1 = Mark, the file location will be F:/Mark's Directory/Filename.xls

Any suggestions would be appreciated.



Norman Jones[_2_]

File Location Based on Cell Reference
 
Hi Monk,



Perhaps try:

'=========
Option Explicit

Public Sub Tester()
Dim WB As Workbook
Dim SH As Worksheet
Dim Rng As Range
Dim aStr As String
Dim sPath As String
Dim FName As String
Const sStr As String = "F:\Home\"
Const sStr2 = "\Trading\2.Draft Trades.xls"

Set WB = ThisWorkbook
Set SH = WB.Sheets("Sheet2") '<<==== CHANGE
Set Rng = SH.Range("A1") '<<==== CHANGE

If Not IsEmpty(Rng.Value) Then
aStr = Rng.Value
FName = sStr & aStr & sStr2
ThisWorkbook.SaveAs Filename:=FName, _
FileFormat:=xlWorkbookNormal
Else
'Your code to handle misssing data, e.g.:
MsgBox Prompt:="Your message", _
Buttons:=vbCritical, _
Title:="Problem"

End If
End Sub
'<<=========



---
Regards.
Norman


"Monk" wrote in message
...
Thanks Norman

I was hoping there may be something less complex. The following code is
part
of an existing module and I was hoping it could pick up the value of cell
A1
(i.e say value = Paul) and enter this in the directory so it would save as
F:\Home\Paul\Trading\2.Draft Trades.xls. If A1 had a value of Mike it
would
save as F:\Home\Mike\Trading\2.Draft Trades.xls. Can the below be
modified
simply?

fileSaveName = Application.GetSaveAsFilename("F:\Home\Cell
A1\Trading\2.Draft Trades.xls", _
"Excel Files (*.xls), *.xls")



Monk[_2_]

File Location Based on Cell Reference
 
Thanks Norman. Perfect.

"Norman Jones" wrote:

Hi Monk,



Perhaps try:

'=========
Option Explicit

Public Sub Tester()
Dim WB As Workbook
Dim SH As Worksheet
Dim Rng As Range
Dim aStr As String
Dim sPath As String
Dim FName As String
Const sStr As String = "F:\Home\"
Const sStr2 = "\Trading\2.Draft Trades.xls"

Set WB = ThisWorkbook
Set SH = WB.Sheets("Sheet2") '<<==== CHANGE
Set Rng = SH.Range("A1") '<<==== CHANGE

If Not IsEmpty(Rng.Value) Then
aStr = Rng.Value
FName = sStr & aStr & sStr2
ThisWorkbook.SaveAs Filename:=FName, _
FileFormat:=xlWorkbookNormal
Else
'Your code to handle misssing data, e.g.:
MsgBox Prompt:="Your message", _
Buttons:=vbCritical, _
Title:="Problem"

End If
End Sub
'<<=========



---
Regards.
Norman


"Monk" wrote in message
...
Thanks Norman

I was hoping there may be something less complex. The following code is
part
of an existing module and I was hoping it could pick up the value of cell
A1
(i.e say value = Paul) and enter this in the directory so it would save as
F:\Home\Paul\Trading\2.Draft Trades.xls. If A1 had a value of Mike it
would
save as F:\Home\Mike\Trading\2.Draft Trades.xls. Can the below be
modified
simply?

fileSaveName = Application.GetSaveAsFilename("F:\Home\Cell
A1\Trading\2.Draft Trades.xls", _
"Excel Files (*.xls), *.xls")




All times are GMT +1. The time now is 03:23 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com