Solved

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

Posted on 2011-03-13
25
557 Views
Last Modified: 2012-08-14
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
Comment
Question by:wlwebb
  • 12
  • 10
  • 3
25 Comments
 
LVL 59

Assisted Solution

by:Chris Bottomley
Chris Bottomley earned 100 total points
ID: 35121404
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
 

Author Comment

by:wlwebb
ID: 35121548
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
 
LVL 30

Assisted Solution

by:SiddharthRout
SiddharthRout earned 400 total points
ID: 35121575
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
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 35121690
>>> Typo - Indeed "example" is exactly what I meant.

Chris
0
 

Author Comment

by:wlwebb
ID: 35121710
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
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35121721
In that case follow what Chris suggested in his first post :)

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

Sid
0
 

Author Comment

by:wlwebb
ID: 35121843
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
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35121849
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
 

Author Comment

by:wlwebb
ID: 35121866
Sounds like a winner!   :-)
0
 
LVL 30

Accepted Solution

by:
SiddharthRout earned 400 total points
ID: 35121961
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
 

Author Comment

by:wlwebb
ID: 35122023
Thanks Sid,  I'll give that a shot
0
 

Assisted Solution

by:wlwebb
wlwebb earned 0 total points
ID: 35123754
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
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35125004
Is it sorted?

Sid
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 35125565
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
 

Author Comment

by:wlwebb
ID: 35125648
Sid
Not sure what you are referring to as sorted. If you are asking about the "filepaths" Wb no it is not sorted.
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35125658
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
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35125661
Ok What is the value of path in

ws3_1.Range("E3").Value

Sid
0
 

Author Comment

by:wlwebb
ID: 35125709
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
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35125727
Which folder is "Shift Details Data.xlsx" in?

Sid
0
 

Author Comment

by:wlwebb
ID: 35125755
Shift Details Data.xlsx is in:
C:\Documents and Settings\Bill.BILL_BACKOFFICE\Desktop\Master Forms\Workpapers\
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35125779
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
 

Author Comment

by:wlwebb
ID: 35125801
Good grief.  Couldn't see the forest for the trees.  Thanks.  That should be a simple fix then.
0
 

Author Comment

by:wlwebb
ID: 35125858
Worked!
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35125866
Great, BTW, I have replied to your other thread as well.

Sid
0
 

Author Closing Comment

by:wlwebb
ID: 35163493
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

Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

Join & Write a Comment

Over the years I have built up my own little library of code snippets that I refer to when programming or writing a script.  Many of these have come from the web or adaptations from snippets I find on the Web.  Periodically I add to them when I comeā€¦
My experience with Windows 10 over a one year period and suggestions for smooth operation
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

746 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now