Am trying to programme a lookup across 2 workbook with workbook path and name linked to cell for dynamic updates ... my current code is getting an error:
"object does not support property or method" on line 29 set lookfor
Can you help me resolve this?
Sub Lookup()
Dim wb1 As String, wb2 As String
Dim wbook1 As Workbook, wbook2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lookFor As Range
Dim srchRange As Range
Dim wb1name As String, wb2name As String
Dim wb1path As String, wb2path As String
Dim sFormulaPre As String, sFormulaSuff As String
Dim rowstart As Long
wb1name = Workbooks("r.xlsm").Sheets("Front sheet").Range("B3").Text
wb2name = Workbooks("r.xlsm").Sheets("Front sheet").Range("AA1").Text
wb1path = Workbooks("r.xlsm").Sheets("Front sheet").Range("AB1").Text
wb2path = Workbooks("r.xlsm").Sheets("Front sheet").Range("AB1").Text
wb1 = wb1path & wb1name
wb2 = wb2path & wb1name
Set wbook1 = Workbooks(wb1name)
Set wbook2 = Workbooks(wb2name)
Set ws1 = wbook1.Sheets("DATA1")
Set ws2 = wbook2.Sheets("DATA")
Set lookFor = wbook2.ws2.Range("$G:$J")
Set srchRange = wbook1.ws1.Range("$A:$E")
Dim bIsEmpty As Boolean
sFormulaPre = "vlookup(D"
sFormulaSuff = ",srchRange, 2,FALSE)"
If IsEmpty(Workbooks("r.xlsm").Sheets("Front sheet").Range("Y1")) = False Then
With wbook2.ws2
rowstart = .Cells(G, 11)
MsgBox sFormulaPre & rowstart & sFormulaSuff
End With
ElseIf IsEmpty(Workbooks("Rates, percentages calculator.xlsm").Sheets("Front sheet").Range("Y1")) = True Then
bIsEmpty = True
End If
End Sub
You already Set your ws2 worksheet object to wbook2, with this line Set ws2 = wbook2.Sheets("DATA")
so change your :
Set lookFor = wbook2.ws2.Range("$G:$J")
to:
Set lookFor = ws2.Range("$G:$J")
The same goes for:
Set srchRange = wbook1.ws1.Range("$A:$E")
should be:
Set srchRange = ws1.Range("$A:$E")
And, change With wbook2.ws2
to: With ws2
Related
Thank you in advance, I need help in completing the below code, the code currently works to add the number of rows in the Table(3) of my word template as per the available rows in excel table, the word template have one row to begin with.
How can I pass the value from excel table range Set Rng = wsSheet.Range("A2:C" & lastrow)
Option Explicit
Sub CopyToWordTemplate()
Const stWordDocument As String = "TemplateSD.docm"
Dim intNoOfRows
Dim objWord As Word.Application
Dim objDoc As Word.Document
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim lRow, i, lastrow, lastcol As Long
Dim vaData As Variant
Dim Rng As Range
Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets("Transmittal")
lastrow = wsSheet.Range("A2").End(xlDown).Row
lastcol = wsSheet.Range("C2").End(xlToRight).Column
Set Rng = wsSheet.Range("A2:C" & lastrow)
Rng.ClearContents
Copy_Criteria_Text
lRow = wsSheet.Range("A2").End(xlDown).Row
intNoOfRows = lRow - 1
Set objWord = New Word.Application
objWord.Visible = True
Set objDoc = objWord.Documents.Open("\\Dn71\dn071\DOCUMENT CONTROL\Common\X-
Templates\Document Control\" & stWordDocument)
With objWord.ActiveDocument
.Bookmarks("Description").Range.Text = wsSheet.Range("D1").Value
.Bookmarks("RevNumber").Range.Text = "C" & wsSheet.Range("E1").Value
.Bookmarks("SubmittalNumber").Range.Text = "DN071-P02-CRC-GEN-PMT-SDA-" & wsSheet.Range("F1").Value
End With
For i = 2 To intNoOfRows
objDoc.Tables(3).Rows.Add
Next
Set objWord = Nothing
End Sub
As said in the title I'm trying to copy data from a column into a new workbook as its a weekly report where the data I add in this column remains valid.
Sub copyColData00()
Dim lastRow As Long
Dim myApp As Excel.Application
Dim wkBk As Workbook
Dim wkSht As Object
Dim mnt As String
Set myApp = CreateObject("Excel.Application")
mnt = InputBox("Enter Filename")
Set wkBk = Workbooks.Open("\\n\Documents\" & mnt & ".xlsx")
lastRow = wkBk.Sheets(1).Range("R" & Rows.Count).End(xlUp).Row
wkBk.Sheets(1).Range("R1:R" & lastRow).Copy
myApp.DisplayAlerts = False
wkBk.Close
myApp.Quit
Set wkBk = Nothing
Set myApp = Nothing
Set wkBk = ActiveWorkbook
Set wkSht = wkBk.Sheets("Sheet1")
wkSht.Activate
Range("R1").Select
wkSht.Paste
Exit Sub
End Sub
My problem is that I want it to past it directly while there I get a prompt that ask if I want to copy all the data in the clip board or not and my second problem is that at
Set wkSht = wkBk.Sheets("Sheet1")
It gives me the error subscript out of range I've trouble understanding what happens there if someone could help it would be nice!
This is a lot easier way to do that:
Sub copyColData00()
Dim lastRow As Long
Dim wkBk1 As Workbook, wkBk2 As Workbook
Dim wkSht As Object
Dim mnt As String
mnt = InputBox("Enter Filename")
Set wkBk1 = ActiveWorkbook
Set wkBk2 = Workbooks.Open("\\n\Documents\" & mnt & ".xlsx")
lastRow = wkBk2.Sheets(1).Range("R" & Rows.Count).End(xlUp).Row
wkBk1.Sheets(1).Range("R1:R" & lastRow).Value = wkBk2.Sheets(1).Range("R1:R" & lastRow).Value 'change which sheet you want for wkBk1
wkBk2.Close
End Sub
I'm trying to figure out a problem in Excel. I am getting an Out of Memory error and I suspect that's not the problem but I don't really know.
Basically, I'm trying to make a macro that searches for a column within 5 tabs in a spreadsheet (the column can be in any of the 5 and it changes a lot) and when it finds it, does a vlookup match to return the column to the appropriate place in the master tab. Here is my code below which seems like it should work but I get the Out of Memory error. the line that is highlighted when I go to debug is the first Vrange = rB line in the if statement.
Dim i As Integer
Dim r As Range
'
Dim wsMaster As Worksheet: Set wsMaster = Workbooks("LBImportMacroTemplate.xlsm").Worksheets("MasterTab")
Dim wsB As Worksheet: Set wsB = Workbooks("LBImportMacroTemplate.xlsm").Worksheets("B")
Dim wsE As Worksheet: Set wsE = Workbooks("LBImportMacroTemplate.xlsm").Worksheets("E")
Dim wsL As Worksheet: Set wsL = Workbooks("LBImportMacroTemplate.xlsm").Worksheets("L")
Dim wsI As Worksheet: Set wsI = Workbooks("LBImportMacroTemplate.xlsm").Worksheets("I")
Dim wsT As Worksheet: Set wsT = Workbooks("LBImportMacroTemplate.xlsm").Worksheets("T")
'
Dim rBHeading As Range: Set rBHeading = wsB.Range("A2:ZA2")
Dim rEHeading As Range: Set rEHeading = wsE.Range("A2:ZA2")
Dim rLHeading As Range: Set rLHeading = wsL.Range("A2:ZA2")
Dim rIHeading As Range: Set rIHeading = wsI.Range("A2:ZA2")
Dim rTHeading As Range: Set rTHeading = wsT.Range("A2:ZA2")
'
Dim rB As Range: Set rB = wsB.Range("A:ZA")
Dim rE As Range: Set rE = wsE.Range("A:ZA")
Dim rL As Range: Set rL = wsL.Range("A:ZA")
Dim rI As Range: Set rI = wsI.Range("A:ZA")
Dim rT As Range: Set rT = wsT.Range("A:ZA")
'
Dim mf_iA_TEXT As String: mf_iA_TEXT = "iA"
'
If Application.CountIf(rBHeading, "iA") = 1 Then
Vrange = rB
Mrange = rBHeading
ElseIf Application.CountIf(rEHeading, "iA") = 1 Then
Vrange = rE
Mrange = rEHeading
ElseIf Application.CountIf(rLHeading, "iA") = 1 Then
Vrange = rL
Mrange = rLHeading
ElseIf Application.CountIf(rIHeading, "iA") = 1 Then
Vrange = rI
Mrange = rIHeading
Else
Vrange = rT
Mrange = rTHeading
End If
'
Dim mf_iA As Variant: mf_iA = Application.Match(mf_iA_TEXT, Mrange, 0)
'
With ActiveSheet
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
MsgBox lastrow
End With
'
For i = 2 To lastrow
wsMaster.Cells(i, 2) = Application.VLookup(wsMaster.Cells(i, 1), Vrange, mf_iA, 0)
Next i
'
End Sub
I also tried to accomplish this with a case statement but I felt like I got further with the above code. If you could please let me know if this code is dumb, or if I can solve the Out of Memory error, I would greatly appreciate it. If I can get this to work, I will be copying the process with many many more columns, in case that matters. Thanks!!
To get you started, the first 56 lines of code could be written as,
Dim v As Long, vWSs As Variant, Mrange As Range, Vrange As Range, mf_iA as long
Dim wsMaster As Worksheet: Set wsMaster = Workbooks("LBImportMacroTemplate.xlsm").Worksheets("MasterTab")
Dim mf_iA_TEXT As String: mf_iA_TEXT = "iA"
vWSs = Array("B", "E", "L", "I", "T")
With Workbooks("LBImportMacroTemplate.xlsm")
mf_iA = 0: Set Mrange = Nothing: Set Vrange = Nothing
For v = LBound(vWSs) To UBound(vWSs)
If CBool(Application.CountIf(.Sheets(vWSs(v)).Range("A2:ZA2"), mf_iA_TEXT)) Then
Set Mrange = .Sheets(vWSs(v)).Range("A2:ZA2")
Set Vrange = .Sheets(vWSs(v)).Range("A:ZA")
' added the column number assignment on the next line
mf_iA = application.match(mf_iA_TEXT, Mrange, 0)
Exit For
End If
Next v
End With
if mf_iA = 0 then msgbox "Stop here! " & mf_iA_TEXT & "not found!"
'assumed that Mrange and Vrange are not nothing at this point
' and that mf_iA is the numerical column index number for mf_iA_TEXT
'do something with them
Set Mrange = Nothing
Set Vrange = Nothing
Set wsMaster = Nothing
That takes you to the end of the If/ElseIf/End If where you can continue processing. The last three are just reminders to manually set the ranges and workbook object to nothing after you are done with them.
I'm getting a "object variable or with block variable not set" error message when running the following code. What is wrong with the code?
Dim directory As String, fileName As String, sheet As Worksheet, i As Integer, j As Integer
Dim mainworkBook As Workbook
Application.ScreenUpdating = False
directory = "C:\Users\425410\Desktop\MYExcel\"
fileName = Dir(directory & "*.xl??")
Dim x As Workbook, y As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Set x = Workbooks.Open(directory & fileName)
Windows("Book3.xlsm").Activate
Set ws1 = x.Sheets(1)
Set ws2 = y.Sheets(1)
With ws1
.Cells.Copy ws2.Cells
y.Close True
x.Close False
End With
As #user3514930 commented you need to set y to a workbook object.
Added some extra code edits.
'<<I think grouping similar types together when declaring variables is clearer than OP
'<<Also I prefer all declarations at the start of subroutines
Dim directory As String, fileName As String
Dim sheet As Worksheet
Dim i As Integer, j As Integer
Dim mainworkBook As Workbook
Dim x As Workbook, y As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Application.ScreenUpdating = False
directory = "C:\Users\425410\Desktop\MYExcel\"
fileName = Dir(directory & "*.xl??")
Set x = Workbooks.Open(directory & fileName)
Windows("Book3.xlsm").Activate
Set y = Workbooks("someopenBook") '<<<<<<<<<<<<<
Set ws1 = x.Sheets(1)
Set ws2 = y.Sheets(1)
'<<not sure why you have the workbook close lines within the With block
With ws1
.Cells.Copy ws2.Cells
End With
y.Close True
x.Close False
This question already has answers here:
Subscript out of range error in this Excel VBA script
(3 answers)
Closed 9 years ago.
This code still gives me an out of subscript error
Sub importData2()
ChDir "C:\Users\Desktop\Java"
Dim filenum(0 To 10) As Long
filenum(0) = 052
filenum(1) = 060
filenum(2) = 064
filenum(3) = 068
filenum(4) = 070
filenum(5) = 072
filenum(6) = 074
filenum(7) = 076
filenum(8) = 178
filenum(9) = 180
filenum(10) = 182
Dim sh1 As Worksheet
Dim rng As Range
Set rng = Range(Selection, ActiveCell.SpecialCells(xlLastCell))
Dim wb As Workbook
Set wb = Application.Workbooks("30_graphs_w_Macro.xlsm")
Dim sh2 As Worksheet
Dim rng2 As Range
Set rng2 = Range("A69")
Dim wb2 As Workbook
For lngposition = LBound(filenum) To UBound(filenum)
Set wb2 = Application.Workbooks.Open(filenum(lngposition) & ".csv")
wb2.Worksheets(filenum(lngposition)).rng.Copy wb.Worksheets(filenum(lngposition)).rng2.Paste
Next lngposition
my_handler:
MsgBox "All done."
End Sub
This still gives me an out of subscript error on the line:
Set wb2 = Application.Workbooks(filenum(lngposition) & ".csv")
I avoided using .active and .select. .select.
Subscript out of Range would raise on that line if the required file is not already open.
Since it seems unlikely that you would already have 11 files open, you probably need to use the Open method to open the necessary workbook inside your loop.
Set wb2 = Application.Workbooks.Open(filenum(lngposition) & ".csv").
Updated your code
Sub importData2()
ChDir "C:\Users\Desktop\Java"
Dim filenum(0 To 10) As String
Dim wb As Workbook
Dim sh1 As Worksheet
Dim rng As Range
Dim wb2 As Workbook
Dim sh2 As Worksheet
Dim rng2 As Range
filenum(0) = "052"
filenum(1) = "060"
filenum(2) = "064"
filenum(3) = "068"
filenum(4) = "070"
filenum(5) = "072"
filenum(6) = "074"
filenum(7) = "076"
filenum(8) = "178"
filenum(9) = "180"
filenum(10) = "182"
'## What workbook is this referring to?? This might cause problems later...
Set rng = Range(Selection, ActiveCell.SpecialCells(xlLastCell))
Set rng2 = Range("A69")
Set wb = Application.Workbooks("30_graphs_w_Macro.xlsm")
For lngposition = LBound(filenum) To UBound(filenum)
Set wb2 = Application.Workbooks.Open(filenum(lngposition) & ".csv")
Set sh1 = wb.Worksheets(filenum(lngposition))
Set sh2 = wb2.Worksheets(1) 'A CSV file only has 1 worksheet.
sh2.rng.Copy Destination:=sh1.Range(rng2.Address)
Next lngposition
my_handler:
MsgBox "All done."
End Sub
You should definitely have Set on the line when you assign worksheets:
Set sh1 = Worksheets(filenum(lngPosition))