I am trying to write a code that checks if two cells on two different worksheets are the same. And, if they are the same, uses VLOOKUP to find the difference between assigned values for those cells (which are in a different column)
This is what I have written so far, and I keep getting the error message
Object doesn't support this property or method
and can not figure out why. Can anyone give input? Thanks!
Sub testing()
Product = Range("A2:A506")
Set myrange = Worksheets("open_prices").Range("A2:D506")
Set myrange2 = Worksheets("close_prices").Range("A2:B506")
Dim popen As Integer
Dim pclose As Integer
Dim ws As Worksheet
For Each Cell In Workbooks("TDO VBA Test.xlsx")
If Worksheets("open_prices").Range("A2:A506") = Worksheets("close_prices").Range("A2:A506") Then
popen = WorksheetFunction.VLookup(Product, myrange, 4, False)
pclose = WorksheetFunction.VLookup(Product, myrange2, 2, False)
result = popen - pclose
End If
Next Cell
End Sub
I am guessing that this is what you are trying to do, i.e. iterate over each cell in one sheet's A2:A506 and see if the value is in the other sheet and, if it is, do the calculation.
Sub testing()
Dim popen As Integer
Dim pclose As Integer
Dim result As Integer ' Are you sure these are integers? Usually prices will be Double
Dim VLookupResult As Variant
Dim cel As Range
For Each cel In Worksheets("open_prices").Range("A2:A506").Cells
popen = cel.Offset(0, 3).Value
VLookupResult = Application.VLookup(cel.Value, Worksheets("close_prices").Range("A2:B506"), 2, False)
If Not IsError(VLookupResult) Then
pclose = VLookupResult
result = popen - pclose
' You will need to decide what to do with this "result" now
' that it has been calculated
End If
Next cel
End Sub
Related
I'm trying to fill blank cells in a certain region with 0. The reagion should be defined in the current workbook but in sheet2 (not the current sheet). Also the place where it is supposed to fill is between columns
BU:CQ in the current region (not all 100 000 000 lines). Just the number of lines that define the table between columns BU and CQ. I know the problem lies in defining the region... See the code below.
What is missing?
Sub FillEmptyBlankCellWithValue()
Dim cell As Range
Dim InputValue As String
On Error Resume Next
InputValue = "0"
For Each cell In ThisWorkbook.Sheets("Sheet2").Range(BU).CurrentRegion
'.Cells(Rows.Count, 2).End(xlUp).Row
If IsEmpty(cell) Then
cell.Value = InputValue
End If
Next
End Sub
I've this code that i'm positive that works! But i don't wnat selection! I want somthing that specifies the sheet and a fixed range.
Now my idea is to replace "selection" with the desired range. - In this case in particular the range should be 1 - between BU:CQ; 2 - starting at row 2; 3 - working the way down until last row (not empty = end of the table that goes from column A to DE)
Sub FillEmptyBlankCellWithValue()
Dim cell As Range
Dim InputValue As String
On Error Resume Next
For Each cell In Selection
If IsEmpty(cell) Then
cell.Value = "0"
End If
Next
End Sub'
PS: And I also need to specify the sheet, since the button that will execute the code will be in the same workbook but not in the same sheet.
Use SpecialsCells:
On Error Resume Next 'for the case the range would be all filled
With ws
Intersect(.UsedRange, .Range("BU:CQ")).SpecialCells(xlCellTypeBlanks).Value = 0
End With
On Error GoTo 0
MUCH faster than looping !
Try using cells() references, such as:
For i = cells(1,"BU").Column to cells(1,"CQ").Column
cells(1,i).value = "Moo"
Next i
In your current code you list Range(BU) which is not appropriate syntax. Note that Range() can be used for named ranges, e.g., Range("TheseCells"), but the actual cell references are written as Range("A1"), etc. For Cell(), you would use Cells(row,col).
Edit1
With if statement, with second loop:
Dim i as long, j as long, lr as long
lr = cells(rows.count,1).end(xlup).row
For i = 2 to lr 'assumes headers in row 1
For j = cells(1,"BU").Column to cells(1,"CQ").Column
If cells(i,j).value = "" then cells(i,j).value = "Moo"
Next j
Next i
First off, you should reference the worksheet you're working with using:
Set ws = Excel.Application.ThisWorkbook.Worksheets(MyWorksheetName)
Otherwise VBA is going to choose the worksheet for you, and it may or may not be the worksheet you want to work with.
And then use it to specify ranges on specific worksheets such as ws.Range or ws.Cells. This is a much better method for specifying which worksheet you're working on.
Now for your question:
I would reference the range using the following syntax:
Dim MyRange As Range
Set MyRange = ws.Range("BU:CQ")
I would iterate through the range like so:
Edit: I tested this and it works. Obviously you will want to change the range and worksheet reference; I assume you're competent enough to do this yourself. I didn't make a variable for my worksheet because another way to reference a worksheet is to use the worksheet's (Name) property in the property window, which you can set to whatever you want; this is a free, global variable.
Where I defined testWS in the properties window:
Public Sub test()
Dim MyRange As Range
Dim tblHeight As Long
Dim tblLength As Long
Dim offsetLen As Long
Dim i As Long
Dim j As Long
With testWS
'set this this to your "BU:CQ" range
Set MyRange = .Range("P:W")
'set this to "A:BU" to get the offset from A to BU
offsetLen = .Range("A:P").Columns.Count - 1
'set this to your "A" range
tblHeight = .Range("P" & .Rows.Count).End(xlUp).Row
tblLength = MyRange.Columns.Count
End With
'iterate through the number of rows
For i = 1 To tblHeight
'iterate through the number of columns
For j = 1 To tblLength
If IsEmpty(testWS.Cells(i, offsetLen + j).Value) Then
testWS.Cells(i, offsetLen + j).Value = 0
End If
Next
Next
End Sub
Before:
After (I stopped it early, so it didn't go through all the rows in the file):
If there's a better way to do this, then let me know.
I've written the following code to copy into cells of certain range of worksheet(1) values of a certain range of worksheet(2) that doesn't match within a certain range of worksheet(3):
Sub sortdata()
Dim i As Integer
Dim n As Integer
Dim w2 As Worksheet
Dim w1 As Worksheet
Dim w3 As Worksheet
Dim SW As String
Dim qrycolvaly As Range
Dim qrycolvalt As Range
Dim r As Range
Dim canceled(1 To 5) As String
Dim performed(1 To 200) As String
Dim startcell As Range
Set w2 = ThisWorkbook.Worksheets(2)
Set w1 = ThisWorkbook.Worksheets(1)
Set w3 = ThisWorkbook.Worksheets(3)
Set startcell = w1.Range("B9")
Set r = w3.Range("C1").End(xlDown)
Set qrycolvaly = w3.Range("C1", r)
For i = 1 To 200
With w2
SW = .Cells(i + 1, 3).Value
If IsError(WorksheetFunction.Match(SW, qrycolvaly, 0)) = True Then
performed(i) = SW
End If
End With
startcell.Offset(i - 1, 0).Value = performed(i)
Next i
End Sub
When there is a SW (certain value of sepcified range of worksheet 2) that doesn't match with values of the specified range of worksheet 3, my code stops on the instruction:
If IsError(WorksheetFunction.Match(SW, qrycolvaly, 0)) = True Then
With the error:
1004:Application-Defined or Object-Defined error
I've tried so many things, specially change type of variables when dim them, but I don't get to make it work.
¿Could anyone tell me what am I doing Wrong?
Use Application.Match in place of WorksheetFunction.Match, it is the VBA equivalent function and won't generate the error message.
You are then using two VBA functions (with IsError) rather than a VBA and an Excel function.
WorksheetFunction.Match returns the Excel value #N/A, whereas Application.Match returns a VBA error value which IsError recognises (Error 2042).
I believe I'm looking for the inverse of the Range Function. I have a named range in my worksheet and in an event macro. I'm interested in getting the range definition string back, such as "A1:A12".
Here is the code I'm working on:
Private Sub UserForm_Initialize()
Dim MyData As Range
Dim r As Long
With Me.ListBox1
.RowSource = ""
Set MyData = Worksheets("Sheet1").Range("A2:D100") 'Adjust the range accordingly
.List = MyData.Cells.Value
For r = .ListCount - 1 To 0 Step -1
If .List(r, 3) = "" Then
.RemoveItem r
End If
Next r
End With
End Sub
I'd rather use the name of the Range in the "Set MyData =" statement above instead of hard-coding the range in the event macro.
If you simply want the address of a Range, use
Dim MyRange as Range
Set MyRange = Worksheets("Sheet1").Range("A2:D100")
' Here do what you want
Msgbox MyRange.Address
.Address will return the "A2:D100" address
https://msdn.microsoft.com/fr-fr/library/office/ff837625.aspx
I am trying to run a macro on 3 different ranges, one after another. Once the range is selected, the code works just fine (where variables F and L are defined). I would like to set r1-r3 as Ranges I need and then use a string variable to concatenate the range numbers together. This code works, but doesn't provide the starting and ending row number in the range selected. This is vital because it tells the "TableCalc" macro when to start and stop the code. I would then like to move on to the next range. Thanks for your help.
Sub TestRangeBC()
WS.Select
Dim r1 As Range
Dim r2 As Range
Dim r3 As Range
Dim rngx As String
Dim num As Integer
Dim rng As Range
Set r1 = WS.Range("ONE")
Set r2 = WS.Range("TWO")
Set r3 = WS.Range("THREE")
For num = 1 To 3
rngx = "r" & num
Set rng = Range(rngx)
Dim F As Integer
Dim L As Integer
F = rng.Row + 1
L = rng.Row + rng.Rows.Count - 2
Cells(F, 8).Select
Do While Cells(F, 8) <> "" And ActiveCell.Row <= L
'INSERT SITUATIONAL MACRO
Call TableCalc
WS.Select
ActiveCell.Offset(1, 0).Select
Loop
Next num
End Sub
This is not the answer (as part of your code and what you are trying to achieve is unclear yet), but it is a "cleaner" and more efficient way to code what you have in your original post.
Option Explicit
Dim WS As Worksheet
Your original Sub shorten:
Sub TestRangeBC()
' chanhe WS to your Sheet name
Set WS = Sheets("Sheet1")
Call ActiveRange("ONE")
Call ActiveRange("TWO")
Call ActiveRange("THREE")
End Sub
This Sub gets the Name of the Named Range (you set in your workbook) as a String, and sets the Range accordingly.
Sub ActiveRange(RangeName As String)
Dim Rng As Range
Dim F As Integer
Dim L As Integer
Dim lRow As Long
With WS
Set Rng = .Range(RangeName)
' just for debug purpose >> to ensure the right Range was passed and set
Debug.Print Rng.Address
F = Rng.Row + 1
L = Rng.Row + Rng.Rows.Count - 2
lRow = F
' what you are trying to achieve in this loop is beyond me
Do While .Cells(F, 8) <> "" And .Cells(lRow, 8).Row <= L
Debug.Print .Cells(lRow, 8).Address
'INSERT SITUATIONAL MACRO
' Call TableCalc
' not sure you need to select WS sheet again
WS.Select
lRow = lRow + 1
Loop
End With
End Sub
What are you trying to test in the loop below, what are the criteria of staying in the loop ?
Do While Cells(F, 8) <> "" And ActiveCell.Row <= L
it's really hard to tell what you may want to do
but may be what follows can help you clarifying and (hopefully) doing it!
first off, you can't "combine" variable names
So I'd go with an array of named ranges names (i.e. String array) to be filled by means of a specific sub:
Function GetRanges() As String()
Dim ranges(1 To 3) As String
ranges(1) = "ONE"
ranges(2) = "TWO"
ranges(3) = "THREE"
GetRanges = ranges
End Function
so that you can clean up your "main" sub code and keep only more relevant code there:
Sub TestRangeBC()
Dim r As Variant
Dim ws As Worksheet
Set ws = Worksheets("Ranges") '<--| change "Ranges" to your actual worksheet name
For Each r In GetRanges() '<--| loop through all ranges names
DoIt ws, CStr(r) '<--| call the range name processing routine passing worksheet and its named range name
Next r
End Sub
the "main" sub loops through the named ranges array directly collected from GetRanges() and calls DoIt() to actually process the current one:
Sub DoIt(ws As Worksheet, rangeName As String)
Dim cell As Range
Dim iRow As Long
With ws.Range(rangeName) '<--| reference the passed name passed worksheet named range
For iRow = .Rows(2).Row To .Rows(.Rows.Count - 2).Row '<--| loop through its "inner" rows (i.e. off 1st and last rows)
Set cell = ws.Cells(iRow, 8) '<--| get current row corresponding cell in column "F"
If cell.value = "" Then Exit For '<--| exit at first blank column "F" corresponding cell
TableCalc cell '<-- call TableCalc passing the 'valid' cell as its parameter
Next iRow
End With
End Sub
Searching through the internet I was able to find some code that creates a countIf function that will not count a cell if there is strikethrough text in it.
Function MyCountif(rng As Range, s As String)
Application.Volatile
Dim i As Long, s1 As String, cell As Range
If Len(s) <> 1 Then
MyCountif = CVErr(xlErrValue)
Exit Function
End If
For Each cell In rng
For i = 1 To Len(cell.Text)
s1 = Mid(cell.Text, i, 1)
If LCase(s1) = LCase(s) Then
If cell.Characters(i, 1).Font.Strikethrough = False Then
MyCountif = MyCountif + 1
End If
End If
Next
Next
End Function
I was wondering if it was possible to make a similar function but instead in the form of a countIfs function that can also ignore the strikethrough text.
Edit: I don't have a ton of vba experience but I did give it a try myself. Since what I need it for will only need two ranges and two criteria I tried to put together something that ran the original function twice and if both criteria were met it would raise the count by one but I haven't quite gotten it to work.
Function MyCountif(rng As Range, s As String, rng2 As Range, p As String)
Application.Volatile
Dim i As Long, numbers(3) As Integer, numbers2(3) As Integer, s1 As String, cell As Range, j As Long, p1 As String, cell2 As Range, first As Long, second As Long
If Len(s) <> 1 Then
MyCountif = CVErr(xlErrValue)
Exit Function
End If
For Each cell In rng
For i = 1 To Len(cell.Text)
s1 = Mid(cell.Text, i, 1)
If LCase(s1) = LCase(s) Then
If cell.Characters(i, 1).Font.Strikethrough = False Then
numbers(i) = 1
End If
End If
Next
Next
For Each cell2 In rng2
For i = 1 To Len(cell2.Text)
p1 = Mid(cell2.Text, i, 1)
If LCase(p1) = LCase(p) Then
If cell.Characters(i, 1).Font.Strikethrough = False Then
numbers2(i) = 1
End If
End If
Next
Next
For i = 0 To 3
If numbers(i) = 1 And numbers2(i) = 1 Then
MyCountif = MyCountif + 1
End If
Next
End Function
I guess here's the pumkin pie! I'm with #findwindow in that I'm not normally in the game of writing an OP's entire solution when there isn't much evidence in the original question of a serious attempt at it (perhaps there has been but the question is just a bit sparse on detail, so apologies if that is the case).
Anyhow, I've been sitting next to a two-year who just won't sleep for the last three hours ... and in between bouts of singing lullabies, threatening father Christmas won't come, stroking a nose, etc., etc. I had a crack at solving this problem.
I didn't have time to think about Excel's CountIf protocol for operators such as greater than, etc., so the last chunk of code just uses the CountIf function.
To the OP, if you're not that familiar with VBA then you should be aware that changing the format of cells to Strikethrough won't trigger a recalculation, so you'll either have to command that manually or capture the format change and force a recalculation (I'll let you research that bit for yourself).
You call the function by entering Range then value pairs. For example: =MyCountIfs(A1:A10,">1",C1:C10,"B").
Public Function MyCountIfs(ParamArray rngCriterionPairs() As Variant) As Variant
'============================================================================================
'Purpose: applies criteria to cells across multiple ranges and aggregates counter for each
' successful match of criterion against cell value in the respective range.
'
'Usage: user must enter one pair of range and criterion values and may enter further
' value pairs in the sequence [range, criterion, range, criterion ...]
'
'Notes: 1. Ranges do not need to be equal in size and do not need to be contiguous.
' 2. Criteria use Excel's CountIf protocol so, for example, ">2" can be used.
' 3. Although this function uses Application.Volatile, changes to cell formats
' won't trigger a recacalculation.
'============================================================================================
Application.Volatile
Dim rangeCriteriaList As Collection 'collection of range/criterion pairs
Dim rcp(1) As Variant 'range/criterion pair
Dim filteredRange As Range 'range object with strikethrough cells removed
Dim workingARange As Boolean 'toggle for testing range-criterion sequence
Dim objTest As Object 'redundant object used for object testing
Dim item As Variant 'variant required to loop through collection
Dim cell As Range 'range object required to loop through cells in range
Dim block As Range 'range object required to loop through areas in range
Dim count As Integer 'aggregates the number of successful hits
Dim i As Integer 'looping variable for paramarray index
'Test the ParamArray paramters
'Must be entered as Range then Variant pairs.
'Excel's CountIfs requires ranges of equal size but we don't need to do that.
'First check parameter has at least two values
If IsEmpty(rngCriterionPairs) Then
MyCountIfs = CVErr(xlErrValue)
Exit Function
End If
If Not IsArray(rngCriterionPairs) Then
MyCountIfs = CVErr(xlErrValue)
Exit Function
End If
'It's an array so loop through the array values
'We'll work through each item and, if it's a Range add it to our rcp(0) variable
'This caters for Ranges separated by commas.
'Once the value isn't a range then it'll be assigned to rcp(1).
'The subsequent value must therefore be a Range and the range test is toggled on/off
'with the workingARange boolean.
Set rangeCriteriaList = New Collection
workingARange = False
For i = 0 To UBound(rngCriterionPairs)
If TypeName(rngCriterionPairs(i)) = "Range" Then
Set filteredRange = NonStrikeThroughCells(rngCriterionPairs(i))
If Not workingARange Then workingARange = True
If Not filteredRange Is Nothing Then
If IsEmpty(rcp(0)) Then 'it's a new range
Set rcp(0) = filteredRange
Else 'it's a non-contiguous range so union with old range
Set rcp(0) = Union(rcp(0), filteredRange)
End If
End If
Else
'It's not a range so workingARange toggle must be set true
If Not workingARange Then
MyCountIfs = CVErr(xlErrValue)
Exit Function
Else
'Toggle the workingARange boolean to false
workingARange = False
'Ignore if the reference range wasn't set
If Not IsEmpty(rcp(0)) Then
'Range then non-range rule is valid, so check the value isn't an object
On Error Resume Next
Set objTest = Nothing: On Error Resume Next
Set objTest = rngCriterionPairs(i): On Error GoTo 0
If Not objTest Is Nothing Then
MyCountIfs = CVErr(xlErrValue)
Exit Function
End If
'It's not an object so we'll use it
rcp(1) = rngCriterionPairs(i)
'Add the range/critrion pair to collection
rangeCriteriaList.Add rcp
'Clear the rcp values
Erase rcp
End If
End If
End If
Next
'Test the last item wasn't a Range
If workingARange Then
MyCountIfs = CVErr(xlErrValue)
Exit Function
End If
'Loop through the collection of ranges and run the count test
'I've used Excel's CountIf function to avoid catering in the code
'for the ">2" type of arguments.
'Purists can have a crack at this within the commented-out block if they wish.
count = 0
For Each item In rangeCriteriaList
For Each block In item(0).Areas
count = count + WorksheetFunction.CountIf(block, item(1))
Next
'For Each cell In item(0).Cells
'If cell.Value = item(1) Then count = count + 1
'Next
Next
'Return the count
MyCountIfs = count
End Function
Private Function NonStrikeThroughCells(rngVar As Variant) As Range
'Removes strikethrough cells from range
Dim rng As Range
Dim cell As Range
Dim result As Range
Set rng = rngVar
For Each cell In rng.Cells
If Not cell.Font.Strikethrough Then
If result Is Nothing Then
Set result = cell
Else
Set result = Union(result, cell)
End If
End If
Next
Set NonStrikeThroughCells = result
End Function
You could simplify your function to return an array of TRUE/FALSE, and use that in a simple array SUM function to do the other conditions rather than over-complicate your VBA
Public Function HasStrikeThrough(rng As Range) As Variant
Dim cell As Range
Dim idx As Long
Dim i As Long
Dim ary As Variant
Application.Volatile
ReDim ary(1 To rng.Cells.Count)
For Each cell In rng
idx = idx + 1
ary(idx) = False
For i = 1 To Len(cell.Text)
If cell.Characters(i, 1).Font.Strikethrough Then ary(idx) = True
Next
Next
HasStrikeThrough = Application.Transpose(ary)
End Function
and your worksheet formula would be like this
=SUM((B1:B10="a")*(C1:C10="y")*(HasStrikeThrough(D1:D10)))