VBA Variable Workbook Reference Runtime-Error 9 - vba

I'm trying to do a VlookUp with two seperate workbooks. The main workbook opens the supporting workbook right at the beginning like this:
Public Sub GetFile()
Dim MySourceSheet As Variant, wb As Workbook
'Opens window to choose file from
MySourceSheet = Application.GetOpenFilename(FileFilter:= _
"Excel Files (*.XLS; *.XLSX), *.XLS; *.XLSX", Title:="Select file to
retrieve data from.")
If MySourceSheet = False Then Exit Sub
Set wb = Workbooks.Open(MySourceSheet)
End Sub
Throughout the module I reference the document a few times, and then there is this part were the error occurs.
Private Sub VlookupToBeReviewed()
Dim LastColumn As Long
Workbooks("09_PR Status Custodians.xlsm").Activate 'change name
'inserts new column
With Sheets("Prio_Custodians")
LastColumn = Cells(2, .Columns.Count).End(xlToLeft).Column 'change row! 'defines last column
For i = LastColumn To LastColumn Step -2 'moves two columns to the left
.Columns(i).Insert
.Columns(i).ColumnWidth = 10
Next
End With
'puts in the date
Cells(3, LastColumn).Value = Date
'sets up the variables for the vlookup
Dim rw As Long, col As Range
Dim twb As Workbook
'sets up the workbooks
Set twb = ThisWorkbook
Set col = Workbooks(MySourceSheet).Sheets("Documents to be reviewed").Range("A:B")
'vlookup function
With twb.Sheets("Sheet1")
For rw = 3 To .Cells(Rows.Count, 1).End(xlUp).Row
.Cells(rw, LastColumn) = Application.VLookup(.Cells(rw, 2).Value2, col, 2, False)
Next rw
End With
End Sub
Error:
Set col = Workbooks(MySourceSheet).Sheets("Documents to be reviewed").Range("A:B")
Spits out the
Run-time error '9' (Subscript out of range)
However, when I move my courser over MySourceSheet it shows the correct workbook as defined earlier in the module. If I put the name of the workbook manually with the .xls extension, it works all perfectly fine.I tried looking for an answer all over the web but nothing could quite fix it. I'd very much appreciate some help! :)

Related

Copying data to another workbook if condition/criteria is satisfied

sorry if this has been asked here many times. I am a beginner in vba excel, so I only have brief idea of how to begin the code. I am using Excel 2013.
I have 2 different workbooks, main and copy.
Row 1 to 4 will be empty.
Row 5 is meant for header/labeling the information it will be providing for both workbooks.
The "main" workbook will be using columns A to DN to store all the data.
If the cell contains "X" - it will copy column A to P, to the workbook "copy". After which, it will go on to the next row to determine the same thing.
If the cell is empty, it will proceed down to the next row to determine the same thing as well.
The code has to be dynamic as new information will be added every 3 months, such as new rows added or the criteria changing from "X" to empty, or empty to "X".
This is the code I have got as of now.
It works but since there are so many columns to check through, I was advised to do another code for this.
Sub copy()
Dim lr As Long, lr2 As Long, r As Long
lr = Sheets("main").Cells(Rows.Count, "A").End(xlUp).row
lr2 = Sheets("copy").Cells(Rows.Count, "A").End(xlUp).row
For r = lr To 2 Step -1
If range("Q" & r).Value = "X" Then
Rows(r).copy Destination:=Sheets("copy").range("A" & lr2 + 1)
lr2 = Sheets("copy").Cells(Rows.Count, "A").End(xlUp).row
End If
Next r
End Sub
For that you will have to declare two workbook variables and two worksheet variables to hold the source and destination workbooks and worksheets reference in the code.
Tweak the following code as per your requirement.
I have added the comments in the code which will help you to understand the flow of the program.
Further, more error handling can be used to make sure the source and destination sheets are found in source and destination workbook respectively.
If required, you can add the error handling as well.
Option Explicit
Sub CopyDatoToAnotherWorkbook()
Dim srcWB As Workbook, destWB As Workbook 'Variables to hold the source and destination workbook
Dim srcWS As Worksheet, destWS As Worksheet 'Variables to hold the source and destination worksheets
Dim FilePath As String 'Variable to hold the full path of the destination workbook including it's name with extension
Dim lr As Long, lr2 As Long, r As Long
Application.ScreenUpdating = False
Set srcWB = ThisWorkbook 'Setting the source workbook
Set srcWS = srcWB.Sheets("main") 'Setting the source worksheet
'Setting the FilePath of the destination workbook
'The below line assumes that the destination file's name is MyFile.xlsx and it is saved at your desktop. Change the path as per your requirement
FilePath = Environ("UserProfile") & "\Desktop\MyFile.xlsx"
'Cheching if the destination file exists, it yes, proceed with the code else EXIT
If Dir(FilePath) = "" Then
MsgBox "The file " & FilePath & " doesn't exist!", vbCritical, "File Not Found!"
Exit Sub
End If
'Finding the last row used in column A on source worksheet
lr = srcWS.Cells(Rows.Count, "A").End(xlUp).Row
'Opening the destination workbook and setting the source workbook
Set destWB = Workbooks.Open(FilePath)
'Setting the destination worksheet
Set destWS = destWB.Sheets("copy")
'Looping through rows on source worksheets
For r = lr To 2 Step -1
'Finding the first empty row in column A on destination worksheet
lr2 = destWS.Cells(Rows.Count, "A").End(xlUp).Row + 1
If srcWS.Range("Q" & r).Value = "X" Then
srcWS.Rows(r).copy Destination:=destWS.Range("A" & lr2 + 1)
End If
Next r
'Closing the destination workbook
destWB.Close True
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

copy cells but not replace them

im stuck at a vba problem.
i want to copy some cells from worksheet to another
first i go through all worksheets begin with "IT*"
For Each ws In wb.Worksheets
If ws.Name Like "IT*" Then
ws.Select
Call transfer
End If
Next ws
then call transfer
Sub transferAP()
'
' transferAP Makro
'
Dim strSheetName As String
strSheetName = ActiveSheet.Name
Sheets(strSheetName).Select
Worksheets(strSheetName).Range("C3").Copy Worksheets("Berechnung_Personal").Range("A3")
Worksheets(strSheetName).Range("E9").Copy Worksheets("Berechnung_Personal").Range("B3")
Worksheets(strSheetName).Range("G9").Copy Worksheets("Berechnung_Personal").Range("C3")
Worksheets(strSheetName).Range("G11").Copy Worksheets("Berechnung_Personal").Range("D3")
Worksheets(strSheetName).Range("C3").Copy Worksheets("Berechnung_Personal").Range("A4")
Worksheets(strSheetName).Range("E24").Copy Worksheets("Berechnung_Personal").Range("B4")
Worksheets(strSheetName).Range("G24").Copy Worksheets("Berechnung_Personal").Range("C4")
Worksheets(strSheetName).Range("G26").Copy Worksheets("Berechnung_Personal").Range("D4")
Worksheets(strSheetName).Range("C3").Copy Worksheets("Berechnung_Personal").Range("A5")
Worksheets(strSheetName).Range("E39").Copy Worksheets("Berechnung_Personal").Range("B5")
Worksheets(strSheetName).Range("G39").Copy Worksheets("Berechnung_Personal").Range("C5")
Worksheets(strSheetName).Range("G41").Copy Worksheets("Berechnung_Personal").Range("D5")
Worksheets(strSheetName).Range("C3").Copy Worksheets("Berechnung_Personal").Range("A6")
Worksheets(strSheetName).Range("M3").Copy Worksheets("Berechnung_Personal").Range("B6")
Worksheets(strSheetName).Range("O3").Copy Worksheets("Berechnung_Personal").Range("C6")
Worksheets(strSheetName).Range("O5").Copy Worksheets("Berechnung_Personal").Range("D6")
Worksheets(strSheetName).Range("C3").Copy Worksheets("Berechnung_Personal").Range("A7")
Worksheets(strSheetName).Range("M18").Copy Worksheets("Berechnung_Personal").Range("B7")
Worksheets(strSheetName).Range("O18").Copy Worksheets("Berechnung_Personal").Range("C7")
Worksheets(strSheetName).Range("O20").Copy Worksheets("Berechnung_Personal").Range("D7")
Worksheets(strSheetName).Range("C3").Copy Worksheets("Berechnung_Personal").Range("A8")
Worksheets(strSheetName).Range("M33").Copy Worksheets("Berechnung_Personal").Range("B8")
Worksheets(strSheetName).Range("O33").Copy Worksheets("Berechnung_Personal").Range("C8")
Worksheets(strSheetName).Range("O35").Copy Worksheets("Berechnung_Personal").Range("D8")
Worksheets(strSheetName).Range("C3").Copy Worksheets("Berechnung_Personal").Range("A9")
Worksheets(strSheetName).Range("U3").Copy Worksheets("Berechnung_Personal").Range("B9")
Worksheets(strSheetName).Range("W3").Copy Worksheets("Berechnung_Personal").Range("C9")
Worksheets(strSheetName).Range("W5").Copy Worksheets("Berechnung_Personal").Range("D9")
Worksheets(strSheetName).Range("C3").Copy Worksheets("Berechnung_Personal").Range("A10")
Worksheets(strSheetName).Range("U18").Copy Worksheets("Berechnung_Personal").Range("B10")
Worksheets(strSheetName).Range("W18").Copy Worksheets("Berechnung_Personal").Range("C10")
Worksheets(strSheetName).Range("W20").Copy Worksheets("Berechnung_Personal").Range("D10")
Worksheets(strSheetName).Range("C3").Copy Worksheets("Berechnung_Personal").Range("A11")
Worksheets(strSheetName).Range("U33").Copy Worksheets("Berechnung_Personal").Range("B11")
Worksheets(strSheetName).Range("W33").Copy Worksheets("Berechnung_Personal").Range("C11")
Worksheets(strSheetName).Range("W35").Copy Worksheets("Berechnung_Personal").Range("D11")
It runs at all, but if there is another worksheet ( and there is another) named "IT*" it will replace the copied files cause of the non relative output cell destination.
I want to continue with the new worksheet data at the end of the last copied data.
Hope you get what im trying to explain.
I propose you the following refactoring of your code
Sub transferAP(sourceSht As Worksheet)
With Worksheets("Berechnung_Personal") '<--| reference target sheet
With .Cells(.Rows.Count, 1).End(xlUp).Offset(1) '<--| reference its column A first empty cell after last not empty one)
sourceSht.Range("C3").Copy .Cells(1,1)
sourceSht.Range("E9").Copy .Cells(2,1)
sourceSht.Range("G9").Copy .Cells(3,1)
.... and so on: keep in mind that .Cells(1,1) syntax assumes the referenced range as the starting cell
End With
End With
End Sub
And your main sub will call it as follows:
transferAP ws
This is your new Main sub. It is basically unchanged from your earlier code, but I have specified Wb to be ThisWorkbook. You may like to specify another.
Sub Main()
Dim Wb As Workbook
Dim Ws As Worksheet
Dim R As Long
Set Wb = ThisWorkbook
For Each Ws In Wb.Worksheets
If Ws.Name Like "IT*" Then
TransferAP Ws, R ' pass the Ws to the sub
End If
Next Ws
End Sub
In your TransferAP I have also specified ThisWorkbook as the workbook where the target worksheet "Berechnung_Personal" is found. Excel presumes the ActiveWorkbook if no specification is made. Note that ThisWorkbook needs not be the ActiveWorkbook. ThisWorkbook is the Workbook that contains the code. The ActiveWorkbook is the last workbook you looked at before switching to the VBE window or the workbook you activated using code thereafter.
Sub TransferAP(Ws As Worksheet, R As Long)
' 21 Mar 2017
Dim WsTarget As Worksheet
Dim Sources() As String ' List of source cells
Dim i As Integer ' index for Sources
Set WsTarget = ThisWorkbook.Worksheets("Berechnung_Personal")
If R = 0 Then R = 3 ' row 3 is the first row to use
Sources = Split("E9,E24,E39,M3,M18,M33,U3,U18,U33", ",")
For i = 0 To UBound(Sources)
With WsTarget
.Cells(R, 1).Value = Ws.Range("C3").Value
.Cells(R, 2).Value = Ws.Range(Sources(i)).Value
.Cells(R, 3).Value = Ws.Range(Sources(i)).Offset(0, 2).Value
.Cells(R, 4).Value = Ws.Range(Sources(i)).Offset(2, 2).Value
End With
R = R + 1
Next i
End Sub
The TransferAP returns the final value of R to the Main. So, when the next source worksheet is found R will continue counting from where it left off - I hope. I didn't test the loop.

Dynamically copy a worksheet multiple times and rename using VBA in Excel

I am trying to dynamically generate a custom number of worksheets based on a template that we use regularly in excel using VBA.
I have created an "Overview" page where we can input a range which will be used to name the new worksheets but then would like to use a hidden "Master" worksheet to generate the content of these new worksheets.
My code below currently generates the correct number of pages based on the range AND copies our master template page but does not combine the two and leaves them in separate pages.
Sub test()
Dim MyNames As Range, MyNewSheet As Range
Set masterSheet = ThisWorkbook.Worksheets("Master")
Set MyNames = Range("A1:A6").CurrentRegion ' load range into variable
For Each MyNewSheet In MyNames.Cells ' loop through cell range
masterSheet.Copy ThisWorkbook.Sheets(Sheets.Count) 'copy master template sheet
Sheets.Add.Name = MyNewSheet.Value
Next MyNewSheet
MyNames.Worksheet.Select ' move selection to original sheet
End Sub
As you can see, the code generates both the named (blank) worksheets AND copies my master worksheet which defaults to naming as "Master()".
So we just need to replace this line:
Sheets.Add.Name = MyNewSheet.Value
with this line:
ActiveSheet.Name = MyNewSheet.Value
Loop through the list and copy the sheet if the sheet does not already exist.
Sub CopyMaster()
Dim ws As Worksheet, sh As Worksheet
Dim Rws As Long, rng As Range, c As Range
Set sh = Sheets("Overview")
Set ws = Sheets("Master")
With sh
Rws = .Cells(Rows.Count, "A").End(xlUp).Row
Set rng = .Range(.Cells(1, 1), .Cells(Rws, 1))
End With
For Each c In rng.Cells
If WorksheetExists(c.Value) Then
MsgBox "Sheet " & c & " exists"
Else:
ws.Copy After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = c.Value
End If
Next c
End Sub
Function WorksheetExists(WSName As String) As Boolean
On Error Resume Next
WorksheetExists = Worksheets(WSName).Name = WSName
On Error GoTo 0
End Function

Variable Directory in Loop

I'm trying to make a macro that allows the user to select a file (excel file) which then is used to copy down information to the active workbook from that selected file. I don't know how to include the file's variable directory into the code. Anyone got an idea?
Sub Ref()
Dim Path As String
Path = Application.GetOpenFilename
Dim r As Integer
r = 1
For r = 1 To 1000
If Not IsEmpty(Range(Path(Cells(r, 1)))) Then
Cells(r, 1) = Range(Path(Cells(r, 1)))
End If
Next
End Sub
It seems that you have a list of Excel workbooks together with their path(s) in column A. You are going to have to open the workbook if you want to retrieve information from the cell(s) in that workbook.
This generic framework should help you get started on a sub that loops through the values in the active workbook's active worksheet's column A, opens each file listed and transfers the value from A1 to the original workbook's column B.
Sub ref()
Dim wb0 As Workbook, wb1 As Workbook
Dim r As Long, lr As Long
Set wb0 = ActiveWorkbook
With wb0.Sheets("Sheet1")
lr = .Cells(Rows.Count, 1).End(xlUp).Row
For r = 1 To lr
If Not IsEmpty(.Cells(r, 1)) Then
Set wb1 = Workbooks.Open(.Cells(r, 1).Value2)
.Cells(r, 2) = wb1.Sheets("Sheet1").Cells(1, 1).Value
wb1.Close False
End If
Next r
End With
End Sub
You will have to expand on that for your own individual situation but I believe you should see the process as you loop through the workbooks listed in column A.

Copying value cell by cell from one excel to another excel

I want to copy values from one excel file to another excel file, but on later stages of my project, I may need to cross check the value and then paste it in the new excel file. So I dont want to copy whole sheet at a time. I want to copy a value by value.
I was able to open and switch between to excel file but I m not able to copy and paste the values.
Following is the code I tried-
Private Sub CommandButton1_Click()
Dim x As Long
Dim NumRows As Long
Set fromwb = Workbooks.Open("G:\Excel\From.xlsx")
Set towb = Workbooks.Open("G:\Excel\To.xlsx")
fromwb.Activate
NumRows = Range("A1", Range("A1").End(xlDown)).Rows.Count
ReDim a(1 To NumRows)
For x = 1 To NumRows
fromwb.Activate
a(x) = Cells(x, 1).Value
towb.Activate
Cells(x, 1).Value = a(x)
Next x
End Sub
Thanking you in anticipation.
Try out the code below. I hope the comments are very clear!
Option Explicit
Private Sub CommandButton1_Click()
Dim SourceBook As Workbook, DestBook As Workbook
Dim SourceSheet As Worksheet, DestSheet As Worksheet
Dim Index As Long, NumRows As Long
Dim ValidCheck As Boolean
'set references up-front
Set SourceBook = Workbooks.Open("G:\Excel\From.xlsx")
Set SourceSheet = SourceBook.ActiveSheet
With SourceSheet
NumRows = .Range("A", .Rows.Count).End(xlUp).Row '<~ last row in col A
End With
Set DestBook = Workbooks.Open("G:\Excel\To.xlsx")
Set DestSheet = DestBook.ActiveSheet
'loop through col A and write out values to destination
For Index = 1 To NumRows
'...
'do your value validation
'in this space using ValidCheck
'...
If ValidCheck Then '<~ if true write to Dest
DestSheet.Cells(Index, 1) = SourceSheet.Cells(Index, 1)
End If '<~ if not, do not write to Dest
Next Index
End Sub
You just need to specify the to cells as equal to the from cells, no need to loop anything.
Workbooks("To.xlsx").Sheets("ToSheetNameHere").Range("rangehere").Value = Workbooks("From.xlsx").Sheets("FromSheetNameHere").Range("rangehere").Value
Keep in mind if you have macro code in the workbook(s) they will be .xlsm and not .xlsx