VBA Activate a sheet from another Workbook based on Cell Value

[WayneK2]

I am trying to develop vba code in a destination workbook, test.xlsm, which has separate worksheets for a number of ticker symbols, about 100 in all, to update, i.e. copy & paste downloaded financial data, (1) closing price vs. time for each ticker symbol, and (2) dividend yield vs time, for each ticker symbol.

My attempted workbook, test.xlsm, needs to copy/paste column A3 to the last non blank row of A, and column E3 to the last non blank row of E in workbook, Multiple Stock Quote Downloader.xlsm, closed on my computer NAS drive Y, to colums M:N, starting at M7:N7, on the active worksheet for the ticker symbol which is named in cell N2 on the active worksheet in workbook, test.xlsm. So the full address for workbook, Multiple Stock Quote Downloader.xlsm, would be Y://public/investments/Distribution History/Multiple Stock Quote Downloader.xlsm. The vba code needs to get the name of the worksheet in Multiple Stock Quote Downloader.xlsm, from cell N2 in workbook, text.xlsm, on the active sheet whose name is the content of cell N2.

Next the vba code needs to update, i.e. copy and paste, dividend yield vs time data, in workbook Bulk Dividend Downloader,xlsm in the folder Y://public/investments/Distribution History/, on the worksheet specified in cell N2 of test.xlsm, the dividend vs. date data is in columns A:B, starting at row A3:B3 to the last non blank row, for the ticker symbol specified in cell N2 of the N2 worksheet in test.xlsm.

Here is what I have so far but it is not generic but hard coded for only a specific worksheet, identified in N2, in workbook, test.xlsm. Can someone tell me how to make this generic?

Sub UpdateHistoricalDividends2()
'
' UpdateHistoricalDividends2 Macro
'

'
    Windows("Bulk Dividend Downloader.xlsm").Activate
    Sheets("ARTOX").Select
    Range("A3:B3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("test.xlsm").Activate
    Range("P7").Select
    ActiveSheet.Paste
End Sub

Sub UpdateHistoricClosePrice2()
'
' UpdateHistoricClosePrice2 Macro
'

'
    Windows("Multiple Stock Quote Downloader.xlsm").Activate
    Sheets("ARTOX").Select
    Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWindow.ScrollRow = 3660
    ActiveWindow.ScrollRow = 3653
    ActiveWindow.ScrollRow = 3645
    ActiveWindow.ScrollRow = 3631
    ActiveWindow.ScrollRow = 3601
    ActiveWindow.ScrollRow = 3587
    ActiveWindow.ScrollRow = 3506
    ActiveWindow.ScrollRow = 3462
    ActiveWindow.ScrollRow = 3190
    ActiveWindow.ScrollRow = 3131
    ActiveWindow.ScrollRow = 2830
    ActiveWindow.ScrollRow = 2764
    ActiveWindow.ScrollRow = 2609
    ActiveWindow.ScrollRow = 2558
    ActiveWindow.ScrollRow = 2433
    ActiveWindow.ScrollRow = 2381
    ActiveWindow.ScrollRow = 2271
    ActiveWindow.ScrollRow = 2198
    ActiveWindow.ScrollRow = 2043
    ActiveWindow.ScrollRow = 1977
    ActiveWindow.ScrollRow = 1874
    ActiveWindow.ScrollRow = 1735
    ActiveWindow.ScrollRow = 1580
    ActiveWindow.ScrollRow = 1500
    ActiveWindow.ScrollRow = 1411
    ActiveWindow.ScrollRow = 1257
    ActiveWindow.ScrollRow = 1176
    ActiveWindow.ScrollRow = 1095
    ActiveWindow.ScrollRow = 1037
    ActiveWindow.ScrollRow = 912
    ActiveWindow.ScrollRow = 860
    ActiveWindow.ScrollRow = 772
    ActiveWindow.ScrollRow = 721
    ActiveWindow.ScrollRow = 662
    ActiveWindow.ScrollRow = 610
    ActiveWindow.ScrollRow = 552
    ActiveWindow.ScrollRow = 493
    ActiveWindow.ScrollRow = 456
    ActiveWindow.ScrollRow = 419
    ActiveWindow.ScrollRow = 339
    ActiveWindow.ScrollRow = 316
    ActiveWindow.ScrollRow = 258
    ActiveWindow.ScrollRow = 236
    ActiveWindow.ScrollRow = 199
    ActiveWindow.ScrollRow = 170
    ActiveWindow.ScrollRow = 81
    ActiveWindow.ScrollRow = 59
    ActiveWindow.ScrollRow = 37
    ActiveWindow.ScrollRow = 8
    ActiveWindow.ScrollRow = 1
    Range("A2:A3685,E2").Select
    Range("E2").Activate
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("test.xlsm").Activate
    Range("M6").Select
    ActiveSheet.Paste
End Sub

 

[JLGWhiz]

Stand by, still working.

 

[JLGWhiz]

This is written to the narrative in your post. Note: If the destination sheets have existing data in the column being copied to, it will result in that data being overwritten by the new data for however many rows of new data starting on row 7.

Sub t()
Dim wb As Workbook, ssh As Worksheet, dsh As Worksheet, fPath As String
fPath = "Y://public/investments/Distribution History/"
Set ssh = ActiveSheet
    With ssh
        Set wb = Workbooks.Open(fPath & "Multiple stock Quote Downloader.xlsm")
        Set dsh = wb.Sheets(.Range("N2").Value)
        .Range("A3", .Cells(Rows.Count, 1).End(xlUp)).Copy dsh.Range("M7")
        .Range("E3", .Cells(Rows.Count, 5).End(xlUp)).Copy dsh.Range("N7")
        wb.Close True
        Set wb = Nothing
        Set dsh = Nothing
    End With
    With ssh
        Set wb = Workbooks.Open(fPath & "Bulk Dividend Downloader.xlsm")
        Set dsh = Sheets(.Range("N2").Value)
        .Range("A3:B" & .Range("A:B").Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row).Copy dsh.Range("P7")
        wb.Close True
        Set wb = Nothing
        Set dsh = Nothing
    End With
End Sub

The narrative did not specify column P in the second workbook, but the code you posted did use P7 as the anchor cell, so I used that also.

 

[WayneK2]

Thank you for this help. I am struggling to learn vba and this is an early effort for me.
I tried your sub t code in my workbook test.xlsm. I realize I did not give the correct file path to you. Both Multiple Stock Quote Downloader.xlsm and Bulk Dividend Downloader.xlsm are located on a NAS drive connected to my computer. I mapped it to drive letter Y. In windows explorer it is listed as Public (\\SEAGATE-D4-2\admin). The screen shot below show the file tree.

When I run sub t on a sheet BALFX in test.xlsm, I get error messages telling me it cannot find the files on Y. Can you please fix my mess?

WayneK2

Here is the vba code in which I tried to correct the filepath:

Sub t()
Dim wb As Workbook, ssh As Worksheet, dsh As Worksheet, fPath As String
fPath = "Y://Personal Information/Investments/Distribution History/"
Set ssh = ActiveSheet
With ssh
Set wb = Workbooks.Open(fPath & "Multiple stock Quote Downloader.xlsm")
Set dsh = wb.Sheets(.Range("N2").Value)
.Range("A3", .Cells(Rows.Count, 1).End(xlUp)).Copy dsh.Range("M7")
.Range("E3", .Cells(Rows.Count, 5).End(xlUp)).Copy dsh.Range("N7")
wb.Close True
Set wb = Nothing
Set dsh = Nothing
End With
With ssh
Set wb = Workbooks.Open(fPath & "Bulk Dividend Downloader.xlsm")
Set dsh = Sheets(.Range("N2").Value)
.Range("A3:B" & .Range("A:B").Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row).Copy dsh.Range("P7")
wb.Close True
Set wb = Nothing
Set dsh = Nothing
End With
End Sub

 

[JLGWhiz]

I am not that great on network addresses myself. Been too long since I used them. But you can try this and see if it gets you there. If Not, I suggest you get your local IT to help.

Sub t()
Dim wb As Workbook, ssh As Worksheet, dsh As Worksheet, fPath As String
fPath = "[URL="file://\\SEAGATE-D42\admin\public\investments\Distribution"]\\SEAGATE-D42\admin\public\investments\Distribution[/URL] History"
Set ssh = ActiveSheet
    With ssh
        Set wb = Workbooks.Open(fPath & "Multiple Stock Quote Downloader.xlsm")
        Set dsh = wb.Sheets(.Range("N2").Value)
        .Range("A3", .Cells(Rows.Count, 1).End(xlUp)).Copy dsh.Range("M7")
        .Range("E3", .Cells(Rows.Count, 5).End(xlUp)).Copy dsh.Range("N7")
        wb.Close True
        Set wb = Nothing
        Set dsh = Nothing
    End With
    With ssh
        Set wb = Workbooks.Open(fPath & "Bulk Dividend Downloader.xlsm")
        Set dsh = Sheets(.Range("N2").Value)
        .Range("A3:B" & .Range("A:B").Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row).Copy dsh.Range("P7")
        wb.Close True
        Set wb = Nothing
        Set dsh = Nothing
    End With
End Sub

Or you can display the path by opening the workbook and running a snippet like

Sub pth()
Range("A1") = ThisWorkbook.Path 'change the range to a blan cell somewhere on the sheet.
End Sub

Then you can copy that into the code.

 

[Fluff]

How about

fPath = "Y:\Personal Information\Investments\Distribution History\"

 

[WayneK2]

I have been trying to use sub t in my test.xlsm. I finally got it to run without crashing using
fPath = "Y:\Personal Information\Investments\Distribution History"

The first try it crashed but I started to run in with both Multiple Stock Quote Downloader.xlsm and Bulk Dividend Downloader.xlsm already opened. I remember I asked for the vba to open both worksheets
on the assumption I would run test.xlm on any of its worksheets with both Multiple Stock Quote Downloader.xlsm and Bulk Dividend Downloader.xlsm closed.

Next I edited sub t code with this file path: fPath = "Y\Personal Information\Investments\Distribution History". It didn't crash and it did open Stock Quote workbook on worksheet ARTOX (cell value in N2 of
test.xlsm. However, rather than copying column A3 to last non blank row & E3 to last non blank row and then pasting the data to M7:N7 in test.xlsm, it wrote all of column A1:A from worksheet ARTOX
in workbook test.xlsm starting at M7 in worksheet ARTOX of the stock quotes workbook and it wrote all of column W1:W from worksheet ARTOX in workbook test.xlsm starting in column N7 in worksheet
ARTOX of the stock quotes workbook. It seems to have confused the source workbook and the destination workbook, test.xlsm.
Ditto for the dividend information that was supposed to be pasted in columns P7:Q7 in destination workbook, test.xlsm.

Is there anyway I can email you my 3 spreadsheets so you can see what is happening?
WayneK2
Denver, CO
(303) 707-1634

 

[JLGWhiz]

Change from"

.Range("A3", .Cells(Rows.Count, 1).End(xlUp)).Copy dsh.Range("M7")
.Range("E3", .Cells(Rows.Count, 5).End(xlUp)).Copy dsh.Range("N7")

To this"

.Range("A3", .Cells(Rows.Count, 1).End(xlUp)).Copy dsh.Cells(Rows.Count, "M").End(xlUp)(2)
.Range("E3", .Cells(Rows.Count, 5).End(xlUp)).Copy dsh.Cells(Rows.Count, "N").end(xlUp)(2)

and from

.Range("A3:B" & .Range("A:B").Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row).Copy dsh.Range("P7")

To this"

.Range("A3:B" & .Range("A:B").Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row).Copy dsh.Cells(Rows.Count, "P").End(xlUp)(2)

If you read post #3 you will see that I noted this probability earlier. I did not think you really wanted that hard coded.