I'm trying to source data from a separate sheet in excel but the second reference to Ws_Names brings up Runtime Error 1004. How would I correctly source values for a range from another sheet?
Dim Ws_Names As Worksheet
Set Ws_Names = Worksheets("Names")
Dim Ws_Data As Worksheet
Set Ws_Data = Worksheets("Data")
Dim SubTechs As Long, Names_range As Range
SubTechs = Ws_Names.Cells(Rows.Count, 1).End(xlUp).Row 'this works
Set Names_range = Ws_Names.Range(Cells(1, 1), Cells(SubTechs, 2)) 'this doesn't work
It's because when you don't put a leading reference it assumes Activesheet
What
Set Names_range = Ws_Names.Range(Cells(1, 1), Cells(SubTechs, 2)) 'this doesn't work
Actually says is, and your current activesheet isn't Ws_Names
Set Names_range = Ws_Names.Range(Activesheet.Cells(1, 1), Activesheet.Cells(SubTechs, 2))
So the solution is
Set Names_range = Ws_Names.Range(Ws_Names.Cells(1, 1), Ws_Names.Cells(SubTechs, 2))
Related
I am trying to automate the population of a Vlookup formula, looking up values from one worksheet in another. There are two worksheets in the workbook, Suppliers and Products. The product code is looked up from the Products worksheet in the Suppliers worksheet.
This is the code:
Dim lastrow As Long
Sheets("Suppliers").Select
lastrow = ActiveSheet.UsedRange.Rows.Count
Dim SuppliersRnge As Range
Set SuppliersRnge = Range(Cells(2, 2), Cells(lastrow, 3))
' This next try was by declaring the first and last rows and columns in Suppliers sheet as variables and passing values to them (passing values not shown here)
' Set SuppliersRnge = .Range(.Cells(SupplierFirstRow, SupplierFirstColumn), .Cells(SupplierLastRow, SupplierLastColumn))
' This next try was by declaring the range as a static set of cells rather than using lastrow
' Set SuppliersRnge = Range("B2:C23")
' This next try was to pick cell references from currently active worksheet
' Set SuppliersRnge = .Range(.Cells(2, 2), .Cells(lastrow, 3))
' This next try was by fully qualifying the name of the worksheet from which the cell reference is drawn
' Set SuppliersRnge = Worksheets(Suppliers).Range(Cells(2, 2), Cells(lastrow, 3))
' Now switching to product sheet
Sheets("Products").Select
' Selecting cell in which vlookup will be added
Range("A4").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[1],SuppliersRnge,2,FALSE)"
I am declaring SuppliersRnge as a range and using Set to pass to it the range of cells that need to be looked up.
I have tried to do it in five different ways (you will find four of the ways commented out above) with the same result, which is that the string SuppliersRnge literally gets used in the vlookup, resulting in a >#NAME? value where the result of the Vlookup should be.
When I run ?SuppliersRnge in the Immediate window, I get the Type Mismatch (Run-time Error 13).
If I run a Watch on the SuppliersRnge variable, it starts with a "Nothing" value then changes to a blank.
Any idea on where I might be going wrong? Thanks!
Formulas in VBA
Note the single quotes (around the worksheet name) which are only necessary if the worksheet name contains spaces, but it is good practice to use them always.
Option Explicit
Sub writeVLookupFormula()
Const sName As String = "Suppliers" ' Source
Const dName As String = "Products" ' Destination
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
Dim sLast As Long: sLast = sws.UsedRange.Rows.Count
Dim srg As Range: Set srg = sws.Range(sws.Cells(2, 2), sws.Cells(sLast, 3))
Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
' R1C1-style
Dim dFormula As String: dFormula = "=VLOOKUP(RC[1],'" & sName & "'!" _
& srg.Address(, , xlR1C1) & ",2,FALSE)"
dws.Range("A4").FormulaR1C1 = dFormula
' Or:
' ' A1-style
' Dim dFormula As String: dFormula = "=VLOOKUP(B4,'" & sName & "'!" _
' & srg.Address & ",2,FALSE)"
' dws.Range("A4").Formula = dFormula
End Sub
I have a huge list of data and column 3 contains email addresses.
I'm trying to copy rows based on a mailing list. As long as the row contains one of the email addresses in the mailing list it should be copied to a new sheet.
I have code to copy data based on one email at a time.
I have a userform set up for several email addresses, but this is not efficient.
Here is my code that uses one email address at a time.
Private Sub CommandButton1_Click()
a = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To a
If Worksheets("Sheet1").Cells(i, 3).Value = "<#gmail.com>" Then
Worksheets("Sheet1").Rows(i).Copy
Worksheets("Sheet2").Activate
b = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Sheet2").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Sheet2").Activate
End If
Next
Application.CutCopyMode = False
End Sub
How to copy rows based on multiple emails addresses?
I would suggest using the Advanced Filter The destination range will get written in a single step. If you can minimize the number of times your code reads/writes to/from a worksheet, the faster it will run.
Sheet 1
Read the comments in the code as they will be important for modifying it to your real data.
In particular, if your column 3 list does not have the same format as what you have shown in your code, you will need to modify the Criteria range to account for that. The Advanced Filter can also accept wild-cards in the criteria, so this might be another possible approach if your column 3 contains actual email addresses.
Option Explicit
Sub copyWithEmail()
Dim wsSrc As Worksheet, wsDest As Worksheet
Dim rSrc As Range, rDest As Range, rCrit As Range
Dim arrCrit As Variant
Dim I As Long
Set wsSrc = Worksheets("sheet1")
Set wsDest = Worksheets("sheet2")
With wsDest
.Cells.Clear 'optional
Set rCrit = .Cells(1, 250) 'someplace off the screen view
Set rDest = .Cells(1, 1)
End With
'assumes original data starts in A1
'assumes first row is a header row
Set rSrc = wsSrc.Cells(1, 1).CurrentRegion
'can get list of desired emails from user form; range someplace in the workbook; or hard-coded as we have here
arrCrit = Array("gmail.com", "abc.com")
For I = 0 To UBound(arrCrit)
'creating formula that mimics what you show in your code above.
arrCrit(I) = "=" & """=<#" & arrCrit(I) & ">"""
Next I
'create criteria range
'header is same header as in Source Data column 3
Set rCrit = rCrit.Resize(2 + UBound(arrCrit))
rCrit(1) = rSrc(1, 3)
rCrit.Offset(1).Resize(rCrit.Rows.Count - 1) = WorksheetFunction.Transpose(arrCrit)
'Activate wsDest since we will be copying here
wsDest.Activate
rSrc.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=rCrit, CopyToRange:=rDest, Unique:=False
rDest.CurrentRegion.EntireColumn.AutoFit
rCrit.Clear 'get rid of this range
End Sub
Sheet 2
May be something like having Sheet3 of mialList and then
Private Sub CommandButton1_Click()
Dim Sh1 As Worksheet, Sh2 As Worksheet, Sh3 As Worksheet, fnd As Range, cl As Range
Set Sh1 = Worksheets("Sheet1")
Set Sh2 = Worksheets("Sheet2")
Set Sh3 = Worksheets("Sheet3")
Dim mailList As Range
x = Sh3.Range("A" & Sh3.Rows.Count).End(xlUp).Row
Set mailList = Sh3.Range("A2:A" & x)
'Assuming headers in row 1
For Each cl In mailList
b = Sh2.Range("A" & Sh2.Rows.Count).End(xlUp).Row + 1
Set fnd = Sh1.Columns(3).Find(cl)
If Not fnd Is Nothing Then
Sh2.Rows(b).Value = Sh1.Rows(fnd.Row).Value
End If
Next
End Sub
I have a simple need to copy range from one sheet to another and I can do it differently, but I want to understand why this code dont work. Please, could you explain ?
Sub cioy()
Dim wb As Workbook
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set wb = ActiveWorkbook
Set sh1 = wb.Sheets("sh1")
Set sh2 = wb.Sheets("sh2")
sh2.Cells.ClearContents
sh1.Range(Cells(1, 1), Cells(12, 8)).Copy Destination:=sh2.Range(Cells(1, 1))
End Sub
it's because Range() property of Worksheet object would accept two Range parameters (the starting and ending range references of the wanted range) while you're giving only one (Range(Cells(1, 1)).
so you would code:
sh1.Range(Cells(1, 1), Cells(12, 8)).Copy Destination:=sh2.Cells(1, 1)
or:
sh1.Range(Cells(1, 1), Cells(12, 8)).Copy Destination:=sh2.Range("A1")
what above should fix the error
also, be aware that without an explicit Sheet reference, a Range object would implicitly take it as ActiveSheet, so your code would be the same as:
sh1.Range(ActiveSheet.Cells(1, 1), ActiveSheet.Cells(12, 8)).Copy Destination:=sh2.Cells(1, 1)
which may not be what you need if sh1 isn't the currently Active sheet.
hence you would more properly write:
sh1.Range(sh1.Cells(1, 1), sh1.Cells(12, 8)).Copy Destination:=sh2.Cells(1, 1)
or:
Range(sh1.Cells(1, 1), sh1.Cells(12, 8)).Copy Destination:=sh2.Cells(1, 1)
where you can notice you can omit the outer sheet reference, since using qualified Range references as parameters of a Range property leads the returned Range reference the same sheet as that of the two parameters ones
finally you could avoid all that burden by using the Range(string address, string address) notation of Range property and simply code:
sh1.Range("A1:H12").Copy Destination:=sh2.Cells(1, 1)
or:
sh1.Range("A1:H12").Copy Destination:=sh2.Range("A1")
Qualify your ranges with parent sheet name and you don't need Range wrapping Cells at end
Public Sub cioy()
Dim wb As Workbook
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set wb = ActiveWorkbook
Set sh1 = wb.Worksheets("sh1")
Set sh2 = wb.Worksheets("sh2")
sh2.Cells.ClearContents
With sh1
.Range(.Cells(1, 1), .Cells(12, 8)).Copy Destination:=sh2.Cells(1, 1)
End With
End Sub
I'm struggling to use the Range Cells method with Index Match in VBA. Using standard ranges works fine, but I'm having no luck with Range Cells. I must be failing to grasp something fundamental about Index Match. I have commented out the lines of code that fail. I appreciate any pointers the community can provide.
Sub IndexMatchTroubleShooting()
'dim worksheets
Dim Source As Worksheet
Dim Target As Worksheet
'set worksheets
Set Source = ThisWorkbook.Sheets("Source")
Set Target = ThisWorkbook.Sheets("Target")
'dim ranges
Dim ValuesToPull As Range
Dim TargetIDs As Range
Dim SourceIDs As Range
Dim MyRange As Range
'using range <-this works
Set ValuesToPull = Source.Range("B1:B5682")
Set TargetIDs = Target.Range("A1:A21")
Set SourceIDs = Source.Range("A1:A5682")
Set MyRange = Target.Range("B1:B21")
'using range cells <-this produces this error: "Run-time Error 1004 Method 'Range' of object '_Worksheet' failed"
'Set ValuesToPull = Source.Range(Cells(1, 2), Cells(5682, 2))
'Set TargetIDs = Target.Range(Cells(1, 1), Cells(21, 1))
'Set SourceIDs = Source.Range(Cells(1, 1), Cells(5682, 1))
'Set MyRange = Target.Range(Cells(1, 2), Cells(21, 2))
'apply formula
MyRange = Application.Index(ValuesToPull, Application.Match(TargetIDs, SourceIDs, 0))
End Sub
You need to fully qualify all Range/Cells references with a sheet as this will error if a different sheet is active when the macro is run, e.g.
Set ValuesToPull = Source.Range(Source.Cells(1, 2), Source.Cells(5682, 2))
or to save a bit of typing
With Source
Set ValuesToPull = .Range(.Cells(1, 2), .Cells(5682, 2))
Set SourceIDs = .Range(.Cells(1, 1), .Cells(5682, 1))
End With
With Target
Set TargetIDs = .Range(.Cells(1, 1), .Cells(21, 1))
Set MyRange = .Range(.Cells(1, 2), .Cells(21, 2))
End With
(Not sure you can use a multi-cell range in a match formula like that - does anyone know?)
Sub MatchMaster()
'this script helps simplify the use of Excel's Index Match function
'place this script in your personal macro workbook and assign it to a button
'use it to pull data between two worksheets that share unique identifiers
'dim ranges
Dim ValuesToPull As Range
Dim TargetIDs As Range
Dim SourceIDs As Range
Dim MyRange As Range
'dim worksheets
Dim Source1 As Worksheet
Dim Target1 As Worksheet
Dim Source2 As Worksheet
Dim Target2 As Worksheet
'input box dims
Dim Prompt1 As String
Dim Prompt2 As String
Dim Prompt3 As String
Dim Prompt4 As String
Dim Title1 As String
Dim Title2 As String
Dim Title3 As String
Dim Title4 As String
'set prompts
Prompt1 = "Select values to pull (1 column only)"
Prompt2 = "Select unique IDs on target sheet (1 column only)"
Prompt3 = "Select unique IDs on source sheet (1 column only)"
Prompt4 = "Where should we put these values? (1 column only)"
'set titles
Title1 = "Source Sheet"
Title2 = "Target Sheet"
Title3 = "Source Sheet"
Title4 = "Target Sheet"
'error handling
On Error GoTo OuttaHere
'input boxes
Set SourceIDs = Application.InputBox(Prompt3, Title3, Type:=8)
Set Source1 = SourceIDs.Worksheet
SourceIDcolumn = SourceIDs.Column
LastSourceID = Source1.Cells(Rows.Count, SourceIDcolumn).End(xlUp).Row
Source1.Activate
Set ValuesToPull = Application.InputBox(Prompt1, Title1, Type:=8)
Set Source2 = ValuesToPull.Worksheet
ValuesColumn = ValuesToPull.Column
LastValue = Source2.Cells(Rows.Count, ValuesColumn).End(xlUp).Row
Source2.Activate
Set TargetIDs = Application.InputBox(Prompt2, Title2, Type:=8)
Set Target1 = TargetIDs.Worksheet
TargetIDcolumn = TargetIDs.Column
LastTargetID = Target1.Cells(Rows.Count, TargetIDcolumn).End(xlUp).Row '<~~ also use this for MyRange
Target1.Activate
Set MyRange = Application.InputBox(Prompt4, Title4, Type:=8)
Set Target2 = MyRange.Worksheet
MyColumn = MyRange.Column
Target2.Activate
'convert input to Range Cells format
With Source1
Set SourceIDs = .Range(.Cells(1, SourceIDcolumn), .Cells(LastSourceID, SourceIDcolumn))
End With
With Source2
Set ValuesToPull = .Range(.Cells(1, ValuesColumn), .Cells(LastValue, ValuesColumn))
End With
With Target1
Set TargetIDs = .Range(.Cells(1, TargetIDcolumn), .Cells(LastTargetID, TargetIDcolumn))
End With
With Target2
Set MyRange = .Range(.Cells(1, MyColumn), .Cells(LastTargetID, MyColumn))
End With
'apply formula
MyRange = Application.Index(ValuesToPull, Application.Match(TargetIDs, SourceIDs, 0))
OuttaHere:
ActiveWorkbook.ActiveSheet.Columns.AutoFit
End Sub
I have a listbox on sheet1 with a list of sheetnames. When somebody double clicks on a name in the list, the code is supposed to activate that sheet, select some data and create a graph out of it.
The code is fine, right up until I ask it to define a range on the other sheet. I've had a number of different error messages and as best I can tell, the code is simply refusing to do anything that is not on sheet1. If somebody could explain why, that would be brilliant.
Code: the listbox is called Stocklist
Option Explicit
Sub StockList_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Call stockgraph
End Sub
Private Sub stockgraph()
Application.ScreenUpdating = False
Dim stockrange As Range
Dim daterange As Range
Dim security_name As String
Dim finalrow As Integer
Dim stockarray() As Double
Dim datearray() As String
Dim cell As Range
security_name = Empty
security_name = StockList.Value
If security_name = Empty Then MsgBox ("something's gone wrong, excel doesn't recognise that value") ' DEBUG
Worksheets(security_name).Activate ' --> this bit works fine
finalrow = ActiveSheet.Cells(1, 1).End(xlDown).row ' --> as does this
Set stockrange = Sheets(security_name).Range(Cells(2, 3), Cells(finalrow, 3))
' --> This gives a 1004 error, so does using activesheet
' --> if I don't reference a sheet, despite it not being the activesheet, the ranges are defined on sheet1
' --> and yet, the code was perfectly fine defining finalrow
Set daterange = Sheets(security_name).Range(Cells(2, 1), Cells(finalrow, 1))
ReDim stockarray(1 To finalrow - 1) As Double ' row 1 is a header so 2 to finalrow = 1 to finalrow-1
ReDim datearray(1 To finalrow - 1) As String
For Each cell In stockrange
stockarray(cell.row - 1) = cell.Value
Next cell
For Each cell In daterange
datearray(cell.row - 1) = cell.text
Next cell
Sheets("Top 10 holdings").Activate
' Create graph
Dim c As Chart
Dim s1 As Series
ActiveSheet.Cells(50, 50) = stockarray
ActiveSheet.Shapes.AddChart.Select
Set c = ActiveChart
Set s1 = c.SeriesCollection(1)
c.ChartType = xlLine
s1.Values = stockarray
Application.ScreenUpdating = True
End Sub
You cannot construct a cell range reference in that manner without fully qualifying the internal cell references used as demarcation points.
With Sheets(security_name)
finalrow = .Cells(1, 1).End(xlDown).row
Set stockrange = .Range(.Cells(2, 3), .Cells(finalrow, 3))
Set daterange = .Range(.Cells(2, 1), .Cells(finalrow, 1))
End With