PDA

View Full Version : [SOLVED] Linking to cells in another sheet with VBA - Can my code be improved?



manka
07-11-2016, 06:46 AM
Hi,

I have a template spreadsheet which is then populated based on files that are in different folders to the main spreadsheet and each location will vary by period. I really struggled to come up with a function that would reference the workbook (which could vary by name but not format) abd eventually came up with the following (with the scripting run time loaded within VBA). The stumbling block for me was trying to get the path name without having to use some form of formula to do this and I'm sure there is a way, but I'm too much of a VBA novice to understand the ins and outs of guidance that has been offered on the web when faced with this other problem.

My solution works for my purposes, but I would perhaps like to improve it further, say if any of the values in J16 to J18 in the other workbooks are blank that some form of error handling is invoked to highlight to the user that this is the case.

Any suggestions would be gratefully received.



Sub filepathforRelevantFile()
Dim fso As New FileSystemObject
Dim fileName As String
Dim filepath As String
Dim folderName As String
Dim filepath2 As String

Sheets("Subsidiary return values").Activate
filepath = GetFile
fileName = fso.GetFileName(filepath)
fullfilepath = fso.GetAbsolutePathName(filepath)

Range("A1").Value = "Entity"
Range("B1").Value = "Full file location"
Range("C1").Value = "File name"
Range("D1").Value = "File path"
Range("E1").Value = "BOX 1"
Range("F1").Value = "BOX 2"
Range("G1").Value = "BOX 3"
Range("H1").Value = "BOX 4"
Range("I1").Value = "BOX 5"
Range("J1").Value = "BOX 6"
Range("K1").Value = "BOX 7"
Range("L1").Value = "BOX 8"
Range("M1").Value = "BOX 9"
Range("A2").Value = "Entity Name"
Range("B2").Value = fullfilepath
Range("C2").Value = fileName

Sheet = "Overall Summary"
Range("D2").FormulaR1C1 = "=LEFT(RC[-2],LEN(RC[-2])-LEN(RC[-1]))"
filepath2 = Sheets("Subsidiary return values").Range("D2")
Range("E2").Value = "='" & filepath2 & "[" & fileName & "]" & Sheet & "'!J6" 'the cell reference would not change
Range("F2").Value = "='" & filepath2 & "[" & fileName & "]" & Sheet & "'!J9" 'the cell reference would not change
Range("G2").Value = "='" & filepath2 & "[" & fileName & "]" & Sheet & "'!J12" 'the cell reference would not change
Range("H2").Value = "='" & filepath2 & "[" & fileName & "]" & Sheet & "'!j15" 'the cell reference would not change
Range("I2").Value = "='" & filepath2 & "[" & fileName & "]" & Sheet & "'!J18" 'the cell reference would not change
Range("J2").Value = "='" & filepath2 & "[" & fileName & "]" & Sheet & "'!J23" 'the cell reference would not change
Range("K2").Value = "='" & filepath2 & "[" & fileName & "]" & Sheet & "'!J26" 'the cell reference would not change
Range("L2").Value = "='" & filepath2 & "[" & fileName & "]" & Sheet & "'!J29" 'the cell reference would not change
Range("M2").Value = "='" & filepath2 & "[" & fileName & "]" & Sheet & "'!j32" 'the cell reference would not change
Columns("A:M").EntireColumn.AutoFit
End Sub





Function GetFile() As String
Dim filename__path As Variant

filename__path = Application.GetOpenFilename(Title:="Select File To Be Opened")

If filename__path = False Then Exit Function
GetFile = filename__path
End Function

manka
07-11-2016, 07:07 AM
OK, so just figured out that I don't need the file path after all, which means that I'm left with this code:


Sub filepathforRelevantFile()
Dim fso As New FileSystemObject
Dim fileName As String
Dim filepath As String
Dim folderName As String
Dim filepath2 As String

filepath = GetFile
fileName = fso.GetFileName(filepath)
fullfilepath = fso.GetAbsolutePathName(filepath)
Sheet = "Overall Summary"

Sheets("Subsidiary return values").Activate
Range("A1").Value = "Entity"
Range("B1").Value = "Full file location"
Range("C1").Value = "File name"
Range("D1").Value = "File path"
Range("E1").Value = "BOX 1"
Range("F1").Value = "BOX 2"
Range("G1").Value = "BOX 3"
Range("H1").Value = "BOX 4"
Range("I1").Value = "BOX 5"
Range("J1").Value = "BOX 6"
Range("K1").Value = "BOX 7"
Range("L1").Value = "BOX 8"
Range("M1").Value = "BOX 9"

Range("A2").Value = "Entity Name"
Range("B2").Value = fullfilepath
Range("C2").Value = fileName
Range("E2").Value = "='" & "[" & fileName & "]" & Sheet & "'!J6" 'the cell reference would not change
Range("F2").Value = "='" & "[" & fileName & "]" & Sheet & "'!J9" 'the cell reference would not change
Range("G2").Value = "='" & "[" & fileName & "]" & Sheet & "'!J12" 'the cell reference would not change
Range("H2").Value = "='" & "[" & fileName & "]" & Sheet & "'!j15" 'the cell reference would not change
Range("I2").Value = "='" & "[" & fileName & "]" & Sheet & "'!J18" 'the cell reference would not change
Range("J2").Value = "='" & "[" & fileName & "]" & Sheet & "'!J23" 'the cell reference would not change
Range("K2").Value = "='" & "[" & fileName & "]" & Sheet & "'!J26" 'the cell reference would not change
Range("L2").Value = "='" & "[" & fileName & "]" & Sheet & "'!J29" 'the cell reference would not change
Range("M2").Value = "='" & filepath2 & "[" & fileName & "]" & Sheet & "'!j32" 'the cell reference would not change

Columns("A:M").EntireColumn.AutoFit
End Sub


Function GetFile() As String
Dim filename__path As Variant

filename__path = Application.GetOpenFilename(Title:="Select File To Be Opened")
If filename__path = False Then Exit Function
GetFile = filename__path
End Function

SamT
07-11-2016, 08:13 AM
Do you still need help?

See how I edited your code?

The # icon in our Editor's menu will insert CODE Tags.You can copy the code in the VBA Editor, then click the icon and press Ctrl+V , or select the code text in our Post Editor and click the icon

manka
07-11-2016, 08:24 AM
Hi Mark

Thanks for that, I see it now - a case of wood and trees.

I would still appreciate some help with respect to error handling. My amended code was to really highlight that I spent ages a long time worrying about the file path for no good reason!

As I've tried to roll this out to other entities, Getfile function insists on invoking for each Box 1 to Box 9 value that I'm looking to populate but didn't do that for two other entities and not sure why? If there is a way to only call the Getfile function once as well that would help too.

thank you!

SamT
07-11-2016, 10:53 AM
I would still appreciate some help with respect to error handling.How about some more detail in re this request.



roll this out to other entities, Getfile function insists on invoking for each Box 1 to Box 9 value
I am not sure what you mean by the ambiguous term "Entity" and you didn't post the code that is causing problems.

Refactored:
Option Explicit

Sub SamT_VBAExpress()
Dim Headers As Variant
Dim strFormula As String
Dim fso As New FileSystemObject
Dim fileName As String
Dim filepath As String
Dim folderName As String
Dim fullfilepath As String
Dim ShtName As String
Dim Answer As Long

ShtName = "Overall Summary"
Headers = Array("Entity", "Full file location", "File name", "File path", _
"BOX 1", "BOX 2", "BOX 3", "BOX 4", "BOX 5", "BOX 6", "BOX 7", "BOX 8", "BOX 9")

StartHere:
filepath = Application.GetOpenFilename(Title:="Select File To Be Opened")
If Not filepath then
If MsgBox("Try Again") = vbYes then GoTo StartHere 'vbOK instead? Depends on MSgBox Buttons
Else: Exit Sub
End If
End If

fileName = fso.GetFileName(filepath)
fullfilepath = fso.GetAbsolutePathName(filepath)
strFormula = "='[" & fileName & "]" & ShtName & "'!"

With Sheets("Subsidiary return values")
.Range("A1:M1") = Headers

.Range("A2").Value = "Entity Name"
.Range("B2").Value = fullfilepath
.Range("C2").Value = fileName
'Range("D2").Value = filePath '???
.Range("E2").Formula = strFormula & "J6"
.Range("F2").Formula = strFormula & "J9"
.Range("G2").Formula = strFormula & "J12"
.Range("H2").Formula = strFormula & "j15"
.Range("I2").Formula = strFormula & "J18"
.Range("J2").Formula = strFormula & "J23"
.Range("K2").Formula = strFormula & "J26"
.Range("L2").Formula = strFormula & "J29"
.Range("M2").Formula = strFormula & "j32"

.Range("A:M").EntireColumn.AutoFit
End With
End Sub

SamT
07-11-2016, 11:05 AM
An alternate to
.Range("E2").Formula = strFormula & "J6"
.Range("F2").Formula = strFormula & "J9"
.Range("G2").Formula = strFormula & "J12"
.Range("H2").Formula = strFormula & "j15"
.Range("I2").Formula = strFormula & "J18"
.Range("J2").Formula = strFormula & "J23"
.Range("K2").Formula = strFormula & "J26"
.Range("L2").Formula = strFormula & "J29"
.Range("M2").Formula = strFormula & "j32"

Is
Dim i as Long
Dim FormulaRanges As Variant
'
'
'
FormulaRanges = Array("J6" , "J9" , "J12", "j15", "J18", "J23", "J26", "J29", "j32")
For i = 5 to 13
.Cells(2, i).Formula = strFormula & FormulaRanges(i - 5)
Next i

And finally, replace
With Sheets("blah blah")
'
'
'
End With
With
Application.ScreenUpdating = False
With Sheets("blah blah")
'
'
'
End With
Application.ScreenUpdating = True

manka
07-12-2016, 12:03 AM
Thanks for your help with this. Sorry about the lack of detail. My intention was to use this code as four separate macros, each macro would then reflect a separate entity and the Box 1-9 values that are populated through the strformula you updated will be done when the user selects the relevant file for each macro and the results would show on row 2-5 (each row reflecting a separate entity).

One particular issue I had with one entity when I replicated the code was that it was requesting that I select each file when it tried to populate boxes 1-9. I'm not sure whether it will do that with your code, but I'll give it a try this morning and report back.

Thanks again for your help, much appreciated.

manka
07-12-2016, 01:41 AM
Thanks Matt - this is now the code that works. I had to switch off display alerts for one entity as it kept prompting for update values for each box.

For some reason the If statements would not work (using either vbYes or vbOK) but I can probably live without this anyway. I'm happy with this code now (and learnt some stuff too) so don't worry about spending any more time on it. Thanks for your help!


Sub entity1() ' by SamT_VBAExpress
Dim Headers As Variant
Dim strFormula As String
Dim fso As New FileSystemObject
Dim fileName As String
Dim filepath As String
Dim folderName As String
Dim fullfilepath As String
Dim ShtName As String
Dim Answer As Long
Dim i As Long
Dim FormulaRanges As Variant

ShtName = "Overall Summary"
Headers = Array("Entity", "Full file location", "File name", "File path", _
"BOX 1", "BOX 2", "BOX 3", "BOX 4", "BOX 5", "BOX 6", "BOX 7", "BOX 8", "BOX 9")

StartHere:
filepath = Application.GetOpenFilename(Title:="Select File To Be Opened")
' If Not filepath Then
' If MsgBox("Try Again") = vbOK Then GoTo StartHere 'vbOK instead? Depends on MSgBox Buttons
' Else: Exit Sub
' End If
'End

fileName = fso.GetFileName(filepath)
fullfilepath = fso.GetAbsolutePathName(filepath)
strFormula = "='[" & fileName & "]" & ShtName & "'!"
Application.ScreenUpdating = False
With Sheets("Subsidiary return values")

FormulaRanges = Array("J6", "J9", "J12", "j15", "J18", "J23", "J26", "J29", "j32")
For i = 2 To 10
.Cells(3, i).Formula = strFormula & FormulaRanges(i - 2)
Next i
Range("A3").Value = "Entity 1"
.Range("A:M").EntireColumn.AutoFit
.Range("A:M").NumberFormat = 0#
End With
Application.ScreenUpdating = True
End Sub

snb
07-12-2016, 04:21 AM
This code should be sufficient.

Sub M_snb()
with getobject("G:\OF\example.xlsx").sheets(1)
thisworkbook.Sheets("Subsidiary return values").cells(2,4).resize(,9)=array(.cells(6,10),.cells(9,10),.cells(12,10),.cell s(15,10),.cells(18,10),.cells(23,10),.cells(26,10),.cells(29,10),cells(32,1 0))
.parent.close 0
end with
End Sub

manka
07-12-2016, 05:51 AM
Thanks snb, I've not tried it yet though as I would need the user to define the spreadsheet rather than specify the file name in the macro (as the name could change as would the location). Otherwise, this looks really clever too. Could I replace With getobject("G:\OF\example.xlsx").sheets(1) with With getobject(filename).sheets("Overall Summary") if I use fileName = fso.GetFileName(filepath) as set out in the original code above?

Thanks

snb
07-12-2016, 06:43 AM
Sub M_snb()
With Application.FileDialog(1)
If .Show Then
With GetObject(.SelectedItems(1)).Sheets("Overall Summary")
ThisWorkbook.Sheets("Subsidiary return values").Cells(2, 4).Resize(, 9) = Array(.Cells(6, 10), .Cells(9, 10), .Cells(12, 10), .Cells(15, 10), .Cells(18, 10), .Cells(23, 10), .Cells(26, 10), .Cells(29, 10), Cells(32, 10))
.Parent.Close 0
End With
End If
End With
End Sub

manka
07-12-2016, 06:52 AM
Sweet - thanks a lot - will report back with any issues.