• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 592
  • Last Modified:

vb to set a string value of one workbook using a specific cell's contents from another workbook

Hello experts

Have another stupid quiestion.

I have a workbook (let's call it wb1) that has VB code that sets the path for "wb2" to look for another workbook (let's call it wb2).  The workbooks get copied from machine to machine.  Each machine as different paths so I am constantly having to update the line of code to let it recognize the paths on each machine.  I consider it dangerous to constantly be opening the vb code to correct the problem as inevitably some other line on that code will accidently get changed.

So, I am going to set up a another seperate Excel workbook that has a table of values where the path can get changed. Let say the new workbook will be called "XYZ123filepaths

Below is the code.

The line I am concered with and want to change is
        strCopyFromFileInMachineMoneyPull = "C:\Documents and Settings\Bill\Desktop\Master Forms\Workpapers\Shift Details Data.xlsx"

I am going to create a new paths file named "XYZ123filepaths.xlsx"

Let's say that I use cell (c10) as the cell that I want to define the path for strCopyFromFileInMachineMoneyPull.  Then what code would I have to have to make strCopyFromFileInMachineMoneyPull look to that other Workbook and read in that value to this workbooks vb




Private Sub Worksheet_Activate()
   Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1_1 As Worksheet
    Dim ws2_1 As Worksheet
    Dim strCopyFromFileInMachineMoneyPull As String, strSaveToFileInMachineMoneyPull As String
    Dim inputRange_ws1_1 As Range
    Dim outputRange_ws2_1 As Range
    Dim LastRowInput_ws1_1 As Long
        strCopyFromFileInMachineMoneyPull = "C:\Documents and Settings\Bill\Desktop\Master Forms\Workpapers\Shift Details Data.xlsx"
        strSaveToFileInMachineMoneyPull = "Machine Money Pull.xlsm"
        
        Set wb1 = ActiveWorkbook
        Set ws1_1 = wb1.Sheets("DataLastShift4MachPull")
         
        '~~> Test if save to workbook is open
        On Error Resume Next
            Set wb2 = Workbooks(Dir(strCopyFromFileInMachineMoneyPull))
            Set ws2_1 = wb2.Sheets("DataLastShift4MachPullTemp")
        
        On Error GoTo 0
        
        If wb2 Is Nothing Then
            Set wb2 = Workbooks.Open(strCopyFromFileInMachineMoneyPull)
            Set ws2_1 = wb2.Sheets("DataLastShift4MachPullTemp")
        
        End If

{Bunch of other code.....stripped out}

End Sub

Open in new window

0
wlwebb
Asked:
wlwebb
  • 12
  • 10
  • 3
4 Solutions
 
Chris BottomleyCommented:
Are the two workbooks co-located because if they are then from WB1 for eamole reference workbook 2 by:

thisworkbook.Path & "\wb2.xls"

You can of course use set statements as usual

set wb2 = workbooks.open(thisworkbook.Path & "\wb2.xls")

Chris
0
 
wlwebbAuthor Commented:
Not sure I understand your answer Chris. Not sure what "eamole" is.

The 2 workbooks will be on the same machine but will be in two different directories

ie:
input form will be in
C:\Documents-Settings\Master Forms\

The permanant data file will be in
C:\Data\Permanant Info\
0
 
SiddharthRoutCommented:
wlwebb: I believe that is a typo. Chris must have meant "example" and not "eamole"

My suggestion would be to use input box to accept the path for example:

Private Sub Worksheet_Activate()
    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1_1 As Worksheet, ws2_1 As Worksheet
    Dim strCopyFromFileInMachineMoneyPull As String, strSaveToFileInMachineMoneyPull As String
    Dim inputRange_ws1_1 As Range, outputRange_ws2_1 As Range, RetPath As String
    Dim LastRowInput_ws1_1 As Long
    
    RetPath = InputBox("Please Enter the path of the file:")
    
    If Len(Trim(RetPath)) = 0 Then Exit Sub
    
    strCopyFromFileInMachineMoneyPull = RetPath & "\Shift Details Data.xlsx"
    strSaveToFileInMachineMoneyPull = "Machine Money Pull.xlsm"
    
    Set wb1 = ActiveWorkbook
    Set ws1_1 = wb1.Sheets("DataLastShift4MachPull")
    
    '~~> Test if save to workbook is open
    On Error Resume Next
        Set wb2 = Workbooks(Dir(strCopyFromFileInMachineMoneyPull))
        Set ws2_1 = wb2.Sheets("DataLastShift4MachPullTemp")
    
    On Error GoTo 0
    
    If wb2 Is Nothing Then
        Set wb2 = Workbooks.Open(strCopyFromFileInMachineMoneyPull)
        Set ws2_1 = wb2.Sheets("DataLastShift4MachPullTemp")
    
    End If

'{Bunch of other code.....stripped out}

End Sub

Open in new window


This would save you from

1) Maintaining a separate excel file
2) Extra code.

Sid
0
Restore individual SQL databases with ease

Veeam Explorer for Microsoft SQL Server delivers an easy-to-use, wizard-driven interface for restoring your databases from a backup. No expert SQL background required. Web interface provides a complete view of all available SQL databases to simplify the recovery of lost database

 
Chris BottomleyCommented:
>>> Typo - Indeed "example" is exactly what I meant.

Chris
0
 
wlwebbAuthor Commented:
Sid
Didn't equate Chris' comment to "example".  Thought it might be a vb term that I was unfamiliar with (which are many).

As for your solution, I like that in some situations and I will keep that for future reference.  However, for this specific instance, the people that will be using this are non techie input clerks and so I think I have to resort to code to automate that function..

What I was thinking, don't know if it is correct is that I can use something like:
strCopyFromFileInMachineMoneyPull = value(workbooks("XYZ123filepaths.xlsx").sheets("filepaths).range(c10))

Don't think the syntax is anywhere close to right.

My thoughts, for what they're worth, is that then all of my paths are in one location that I can change all of them.
0
 
SiddharthRoutCommented:
In that case follow what Chris suggested in his first post :)

Since he replied first, I'll let Chris take over. :)

Sid
0
 
wlwebbAuthor Commented:
Any suggestion on the syntax where I refer to a cell in a specific workbook?

....."What I was thinking, don't know if it is correct is that I can use something like:
strCopyFromFileInMachineMoneyPull = value(workbooks("XYZ123filepaths.xlsx").sheets("filepaths).range(c10))

0
 
SiddharthRoutCommented:
If Chris doesn't reply in the next 30 mins, I will give you the code :)

Let's wait for some time. Ok?

Sid
0
 
wlwebbAuthor Commented:
Sounds like a winner!   :-)
0
 
SiddharthRoutCommented:
Here is the code :)

Private Sub Worksheet_Activate()
    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim strCopyFromFileInMachineMoneyPull As String, strSaveToFileInMachineMoneyPull As String
    Dim FilePath As String
    Dim inputRange_ws1_1 As Range, outputRange_ws2_1 As Range
    Dim LastRowInput_ws1_1 As Long
    
    Set wb1 = ActiveWorkbook
    Set ws1 = wb1.Sheets("DataLastShift4MachPull")
     
    '~~> Change file path here
    Set wb2 = Workbooks.Open("C:\XYZ123filepaths.xlsx")
    Set ws2 = wb2.Sheets("filepaths")
    FilePath = ws2.Range("C10").Value '<~~ Contains value like C:\Temp\
    wb2.Close savechanges:=False
    
    strCopyFromFileInMachineMoneyPull = FilePath & "Shift Details Data.xlsx"
    strSaveToFileInMachineMoneyPull = "Machine Money Pull.xlsm"
     
    '~~> Test if save to workbook is open
    On Error Resume Next
    Set wb2 = Workbooks(Dir(strCopyFromFileInMachineMoneyPull))
    Set ws2 = wb2.Sheets("DataLastShift4MachPullTemp")
    
    On Error GoTo 0
    
    If wb2 Is Nothing Then
        Set wb2 = Workbooks.Open(strCopyFromFileInMachineMoneyPull)
        Set ws2 = wb2.Sheets("DataLastShift4MachPullTemp")
    End If

    '{Bunch of other code.....stripped out}
End Sub

Open in new window


Sid
0
 
wlwebbAuthor Commented:
Thanks Sid,  I'll give that a shot
0
 
wlwebbAuthor Commented:
Keeps erroring out.
 Stepped into code and the line that it quits on is about 2/3rds through in the '~~> Test if save to workbook is open section

the line is the one after the On Error Goto 0
         Set wb2 = Workbooks.Open(strCopyFromFileInMachineMoneyPull)
Private Sub Worksheet_TESTINGNEWMachinePull()
 ' Retrieve The Last Shift's LVL Totals for Day as of the End of that Shift to copy as values to the ws DataLastShift4MachPull
    '
    Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook
    Dim ws1_1 As Worksheet
    Dim ws2_1 As Worksheet
    Dim ws3_1 As Worksheet
    Dim strCopyFromFileInMachineMoneyPull As String, strSaveToFileInMachineMoneyPull As String
    Dim inputRange_ws1_1 As Range
    Dim outputRange_ws2_1 As Range
    Dim LastRowInput_ws1_1 As Long

'    Application.Visible = False

    Dim intResponse As Integer
    intResponse = MsgBox("Are you sure you want to begin a New Machine Money Pull?", vbOKCancel + vbInformation)
    If intResponse = vbOK Then
      'Resume, the user pressed ok
    
' This defaults the Calendar object to today
        Sheets("Machine Pull").Calendar1.Value = Date
        
        Application.ScreenUpdating = False
        Sheets("Machine Pull").Select
        Sheets("DataLastShift4MachPull").Visible = True

        
        Set wb1 = ActiveWorkbook
        Set ws1_1 = wb1.Sheets("DataLastShift4MachPull")
         
    '~~> Change file path here so I can use a file path workbook to update where files are instead of going to VB code
    Set wb3 = Workbooks.Open("C:\Documents and Settings\Bill.BILL_BACKOFFICE\Desktop\Master Forms\FilePaths.xlsx")
    Set ws3_1 = wb3.Sheets("FilePaths")
    FilePath = ws3_1.Range("E3").Value '<~~ Contains value like C:\Temp\
    wb3.Close savechanges:=False
    
    strCopyFromFileInMachineMoneyPull = FilePath & "Shift Details Data.xlsx"
    strSaveToFileInMachineMoneyPull = "Machine Money Pull.xlsm"
    
    '~~> End Change file path settings
        
        
        '~~> Test if save to workbook is open
        On Error Resume Next
            Set wb2 = Workbooks(Dir(strCopyFromFileInMachineMoneyPull))
            Set ws2_1 = wb2.Sheets("DataLastShift4MachPullTemp")
        
        On Error GoTo 0
        
        If wb2 Is Nothing Then
            Set wb2 = Workbooks.Open(strCopyFromFileInMachineMoneyPull)
            Set ws2_1 = wb2.Sheets("DataLastShift4MachPullTemp")
        
        End If
    
        '~~> Begin Save info
        Set wb2 = ActiveWorkbook
        LastRowInput_ws2_1 = ws2_1.Range("A" & Rows.Count).End(xlUp).Row
        LastRowOutput_ws1_1 = ws1_1.Range("A" & Rows.Count).End(xlUp).Row
        
        Set inputRange_ws2_1 = ws2_1.Range("A5:AC" & LastRowInput_ws2_1)
        Set outputRange_ws1_1 = ws1_1.Range("A" & LastRowOutput_ws1_1)
        
        
        inputRange_ws2_1.Copy
        outputRange_ws1_1.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False
        
    '    Application.ScreenUpdating = True
        
        
    ' Save updated data file then close
        ActiveWorkbook.Save
        ActiveWorkbook.Close
    '    Application.Visible = True
        Application.ScreenUpdating = True
    
        Application.ScreenUpdating = False
        
        Sheets("Machine Pull").Select
        Sheets("DataLastShift4MachPull").Visible = False
        
        Range("AA21").Select
        Range("Z23").Select
        Application.Goto Reference:="EmployeeSelector"

        Application.ScreenUpdating = True
        
    Else
      'The user pressed cancel
      'Cancel event
      ActiveWorkbook.Saved = True
      Application.Quit
      
      
    End If
    
End Sub

Open in new window

0
 
SiddharthRoutCommented:
Is it sorted?

Sid
0
 
Chris BottomleyCommented:
Looks like Sid's (original) suggestion did not pan out, sad to say I was not monitoring the thread so seemingly let you down ... but thankfully Sid stuck at it so sorry in part for my 'abandonment' but at ;east you got a solution.

Chris
0
 
wlwebbAuthor Commented:
Sid
Not sure what you are referring to as sorted. If you are asking about the "filepaths" Wb no it is not sorted.
0
 
SiddharthRoutCommented:
wlwebb: I was confused that you have accepted the answers so I was confused whether your query is sorted or not :)

Let me look at your last post.

Sid
0
 
SiddharthRoutCommented:
Ok What is the value of path in

ws3_1.Range("E3").Value

Sid
0
 
wlwebbAuthor Commented:
This is a copy and paste of exactly what is in cell e3 of the wb FilePaths.xlsx  I have not deleted any apostrophes or quote marks if they are needed.

C:\Documents and Settings\Bill.BILL_BACKOFFICE\Desktop\Master Forms\Forms Masters\


PS
You must get about as much sleep as I do.  

PSS I started a new question with just this last problem and a new 500 pts
New related question
0
 
SiddharthRoutCommented:
Which folder is "Shift Details Data.xlsx" in?

Sid
0
 
wlwebbAuthor Commented:
Shift Details Data.xlsx is in:
C:\Documents and Settings\Bill.BILL_BACKOFFICE\Desktop\Master Forms\Workpapers\
0
 
SiddharthRoutCommented:
That is why you are getting the errors :)

If

ws3_1.Range("E3").Value = C:\Documents and Settings\Bill.BILL_BACKOFFICE\Desktop\Master Forms\Forms Masters\

then

strCopyFromFileInMachineMoneyPull = FilePath & "Shift Details Data.xlsx"

will give you

C:\Documents and Settings\Bill.BILL_BACKOFFICE\Desktop\Master Forms\Forms Masters\Shift Details Data.xlsx

where as the file is in "Workpapers" folder :)

C:\Documents and Settings\Bill.BILL_BACKOFFICE\Desktop\Master Forms\Workpapers\Shift Details Data.xlsx

Sid
0
 
wlwebbAuthor Commented:
Good grief.  Couldn't see the forest for the trees.  Thanks.  That should be a simple fix then.
0
 
wlwebbAuthor Commented:
Worked!
0
 
SiddharthRoutCommented:
Great, BTW, I have replied to your other thread as well.

Sid
0
 
wlwebbAuthor Commented:
Sid is always a huge help.  Chris also helped but for what I was attempting, Sid's was more in line with what I was attempting.
0

Featured Post

Hire Technology Freelancers with Gigs

Work with freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely, and get projects done right.

  • 12
  • 10
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now