I'm currently writing a program to analyze some data, and my Debugger is throwing the "Duplicate Declaration in Current Scope" error, highlighting "Dim rTickers As Range". I cannot find a duplicate anywhere in here. Is there some other reason I could be getting this error? Thanks for your time.
Sub TSV_Ticker()
'Create Dictionary To get Unique Values From Column A
Dim dTickers As New Dictionary
Dim i As Long
For i = 2 To Rows.Count
On Error Resume Next
dTickers.Add (Cells(i, 1).Value), CStr(Cells(i, 1).Value)
Next
'Create The Ticker And Sum Column Headers
Range("J1").Value = "<Sum>"
Range("I1").Value = "<Ticker>"
'Define where we will be putting our keys
Dim uTickers As Range
Set uTickers = Range("I2")
'Convert Keys into array for syntax reasons
aTickers = dTickers.Keys
'Resize the range so it will fit the array
Set rTickers = rTickers.Resize(UBound(aTickers), 1)
'Put array into range, verticaly
rTickers.Value = Application.Transpose(aTickers)
'Define Range of column A
Dim rTickers As Range
Set rTickers = Range("A2:A" & ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row)
Dim TSV As Long
'Defining some Date Variables (Column B)
Dim fDate As Integer
Dim eDate As Integer
Dim rDates As Range
Set rDates = Range("B2:B" & ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row)
'And The Open / Close Variables (Colums C&F)
Dim vOpen As Double
Dim Vclose As Double
Dim Delta As Double
Dim pDelta As Double
'Adding Some Columns
sht.Range("J1").EntireColumn.Insert
Range("J1").Value = "Yearly Change"
sht.Range("K1").EntireColumn.Insert
Range("K1").Value = "Percent Change"
For Each Cell In rTickers
'Searching our range that we put the Array in for matching Values
Set t = rTickers.Find(Cell.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not t Is Empty Then
'add column G's value to corresponding I value
Cells(t.Row, 10).Value = Cells(t.Row, 10).Value + Cells(Cell.Row, 7).Value
End If
Next Cell
End Sub
As commented, without using Option Explicit variables are created at the first instance.
So in your code, rTickers is already created when this below line is executed:
Set rTickers = rTickers.Resize(UBound(aTickers), 1)
That being said, below line will give you a compile error:
Dim rTickers As Range
because rTickers variable has already been created.
I'll post this as answer for others reference.
But if Rory or Ashlee wish to add their answers, I'll delete mine :).
Related
How can I enter value in excel cell contain many words and search for in database if any word in the search cell matched the words in database just appear for me
am trying to write code but the problem that the code search for one word only and if I write may words in cell the code doesn't work
Sub searchkey()
Dim i As Integer
Dim keyword As String
Dim findrow As Integer
Sheet1.Range("b5:b20").ClearContents
keyword = Sheets("Search").Range("B2").Value
findrow = Sheets("Database").Range("B30").End(xlUp).Row
Sheets("Database").Activate
For i = 2 To findrow
If Sheet2.Cells(i, 2) = keyword Then
Sheet2.Range(Cells(i, 2), Cells(i, 2)).Copy
Sheets("Search").Range("B20").End(xlUp).Offset(1, 0).PasteSpecial
End If
Next i
Sheet1.Activate
End Sub
You need to split the keyword into pieces (in below code, I've called them keywordpart) and search for each one:
Sub searchkey()
Dim i As Integer
Dim keyword As String, keywordpart As Variant
Dim findrow As Integer
Dim wsSearch As Worksheet
Dim wsDatabase As Worksheet
Set wsSearch = Sheets("Search")
Set wsDatabase = Sheets("Database")
wsSearch.Range("b5:b20").ClearContents
keyword = wsSearch.Range("B2").Value
findrow = wsDatabase.Range("B30").End(xlUp).Row
For Each keywordpart In Split(keyword, " ")
For i = 2 To findrow
If wsDatabase.Cells(i, 2) = keywordpart Then
wsDatabase.Range(Cells(i, 2), Cells(i, 2)).Copy
wsSearch.Range("B20").End(xlUp).Offset(1, 0).PasteSpecial
End If
Next i
Next
End Sub
I also took the liberty of tidying up your worksheet referencing - as you sometimes referenced them by name and other times by object name.
I have over 200 worksheets in a given workbook and am trying to get some prices based on given dates. I am trying to use the Find method to search column A in each sheet (apart from the Summary sheet) to find the given date and then offset 4 columns to get the appropriate prices. The code is failing on the fr = r.Offset(0, 4).Value and gives Object variable or With block variable not set error. I have tried tweaking the code and doing some other approaches, but keep getting a similar error.
Sub fill()
ActiveWorkbook.Worksheets("Summary").Activate
Dim From_Date As Variant
Dim To_Date As Variant
From_Date = Range("A2").Value
To_Date = Range("A1").Value
Dim rng As Worksheet
Dim fr As Variant
Dim tr As Variant
Dim pct As Variant
Dim r As Range
For Each rng In ActiveWorkbook.Worksheets
If rng.Name <> "Summary" Then
rng.Activate
Set r = Range("A:A").Find(To_Date)
fr = r.Offset(0, 4).Value
End If
Next rng
End Sub
You need to check the result of the Find() method, as explained here:
Set r = Range("A:A").Find(To_Date)
If Not (r Is Nothing) Then
fr = r.Offset(0, 4).Value
...
End If
(Keep out not to use fr in case r is null, it might still contain the result of the previous loop)
I have data contained in "Sheet1" with only 2 columns. Column "A" and Column "B".
Below are my questions
The below code which is working fine, but at the moment, I have to put every single word within the cell to bring up a result. Is there a way there, where I can type only a word or a few words contained within that cell that it will bring up a result.
Is there a way, if I have 2 different results pulled from the data, like duplicates, what is the code to see the next. Do I need a command button like eg: Next
Private Sub CommandButton1_Click()
Dim rng As Range
Dim cl As Range
Dim vFind
Dim R As Long
Set rng = Sheet1.Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
vFind = Me.TextBox1.Text
With rng
Set cl = .Find(vFind, LookIn:=xlValues)
If Not cl Is Nothing Then R = cl.Row
Me.TextBox2.Value = Cells(R, 2).Value
End With
I'm trying to set up array formula within a for loop to do a partial match of a string to a list of names on another worksheet called Project Name. This should be the end product I got the formula working in the spreadsheet using the method from exceljet but I ran into an error of "object required" when I tried to covert it to VBA. The cells(i,6) is the location of the string that I am trying to do a partial match to the project names. The column doesn't have to be "6", it is where the Please help. Thanks!
Sub Shortname()
Dim SRng As Variant
Dim SName As Integer
Dim SNrow As Integer
Dim PLcol As Integer
Dim PLrow As Integer
Worksheets(3).Activate
SNrow = Cells(Rows.Count, 1).End(xlUp).Row
SRng = Range(Cells(2, 1), Cells(SNrow, 1)).Value
Worksheets(2).Activate
PLcol = Cells(1, Columns.Count).End(xlToLeft).Column + 1
PLrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To PLrow
Cells(i, PLcol).Value = Application.WorksheetFunction.Index(SRng, Application.WorksheetFunction.Match("TRUE", Application.WorksheetFunction.IsNumber(Application.WorksheetFunction.Search(SRng.Value, Cells(i, 6))), 0), 1)
Next i
End Sub
Mysterious Variable (SRng)
I would write the code something like this (not the solution just a more readable version):
Sub Shortname()
Dim SRng As Variant
Dim SName As Integer
Dim SNrow As Integer
Dim PLcol As Integer
Dim PLrow As Integer
'Missing Declaration
Dim i As Long
'To avoid jumping around worksheets do NOT use Activate or Select
With Worksheets(3)
SNrow = .Cells(Rows.Count, 1).End(xlUp).Row
SRng = .Range(Cells(2, 1), Cells(SNrow, 1)).Value
End With
With Worksheets(2)
PLcol = .Cells(1, Columns.Count).End(xlToLeft).Column + 1
PLrow = .Cells(Rows.Count, 1).End(xlUp).Row
End With
With Application.WorksheetFunction
For i = 2 To PLrow
'Run-time error 424: Object required
Worksheets(2).Cells(i, PLcol).Value = .Index(SRng, .Match("TRUE", _
.IsNumber(.Search(SRng.Value, Cells(i, 6))), 0), 1)
Next i
End With
End Sub
The error (mystery) lies in the SRng variable. Why is it declared as variant?
If it is a String declare it as String and change the line SRng = .Range(Cells(2, 1), Cells(SNrow, 1)).Value to
SRng = .Range(Cells(2, 1), Cells(SNrow, 1)).Address
If it is a Range object then declare it as Range and remove .Value,
but then you still get the error in the For Next loop since you use SRng.Value in the Search part of the statement, but a range has no value (maybe you wanted to use something like this SRng.Cells(i, 6).Value).
If this doesn't help you provide some more info like a sample of the worksheet(s) to see what's in the cells, ranges ... and explain what it is you're searching for in the For Next loop.
To be quite honest I am not entirely sure how to describe what it is I am trying to accomplish? But, here it goes anyway. I have an excel sheet containing one column of IDs and a second column of values that need to be associated to the first column. The problem is that the IDs in column A contain duplicates, which is okay because one ID can qualify for multiple values. What I need is to have a third column pull back the unique id, and a fourth column pull back a semi-colon delimited list of all of the values the id qualifies for. Hopefully the attached image makes sense? For what it's worth I have tried every formula I can think of, and I really know nothing about macros, which is what I am thinking needs to be implemented.
Try below code :
Sub sample()
Dim lastRowA As Long, lastRowC As Long
lastRowA = Range("A" & Rows.Count).End(xlUp).Row
lastRowC = Range("C" & Rows.Count).End(xlUp).Row
Dim rng As Range, cell As Range
Set rng = Range("C2:C" & lastRowC)
Dim rngSearch As Range
Set rngSearch = Range("A1:A" & lastRowA)
Dim rngFind As Range
Dim firstCell As String
For Each cell In rng
Set rngFind = rngSearch.Find(What:=cell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows)
If Not rngFind Is Nothing Then
temp = rngFind.Offset(0, 1)
firstCell = rngFind.Address
Do While Not rngFind Is Nothing
Set rngFind = rngSearch.FindNext(After:=rngFind)
If rngFind.Address <> firstCell Then
temp = temp & ";" & rngFind.Offset(0, 1)
Else
Set rngFind = Nothing
End If
Loop
End If
cell.Offset(0, 1) = temp
Next
End Sub
Here's an alternative approach, that has several advantages
it builkds the list of unique sku's
it clear old data from columns C:D
it will run much faster than looping over a range
Sub Demo()
Dim rngA As Range, rng as Range
Dim datA As Variant
Dim i As Long
Dim sh As Worksheet
Dim dic As Object
Set sh = ActiveSheet ' can change this to your worksheet of choice
Set dic = CreateObject("Scripting.Dictionary")
With sh
' Get data from columns A:B into a variant array
Set rngA = .Range(.Cells(2, 2), .Cells(.Rows.Count, 1).End(xlUp))
datA = rngA
' Create list of unique sku's and built value strings
For i = 1 To UBound(datA)
If dic.Exists(datA(i, 1)) Then
dic(datA(i, 1)) = dic(datA(i, 1)) & ";" & datA(i, 2)
Else
dic.Add datA(i, 1), datA(i, 2)
End If
Next
' Clear exisating data from columns C:D
Set rng = .Range(.Cells(2, 4), .Cells(.Rows.Count, 3).End(xlUp))
If rng.Row > 1 Then
rng.Clear
End If
' Put results into columns C:D
.Range(.Cells(2, 3), .Cells(dic.Count + 1, 3)) = Application.Transpose(dic.Keys)
.Range(.Cells(2, 4), .Cells(dic.Count + 1, 4)) = Application.Transpose(dic.Items)
End With
End Sub
How to add this:
Start the VBS editor (Alt+F11 from excel)
show project explorer, if its not already visible (Ctrl+R)
add a Module (right click on your workbook, Insert, Module)
open the module (dbl click)
Add Option Explicit as the first line, if not already there
copy paste this code into module
How to run it, from Excel
activate the sheet with your data
open macro dialog (Alt+F8)
select Demo from list and run