I am working on a problem to loop through a certain number of columns and paste in an array formula. For every new column, I have to change the formula to reflect that column address. However, when I try to run it now, I keep getting a 1004 (select method of range class failed) error. Here is what I have written:
Sub Testlee()
Dim i As Integer
Dim LastColumn As Long
Dim rng As Range
Dim colStr As String
LastColumn = 10
For i = 1 To LastColumn
colStr = Replace(Split(Columns(i).Address, ":")(0), "$", "")
ThisWorkbook.Sheets("Data Validation").Range(colStr & "2:" & colStr & "500").Select
Selection.FormulaArray = "=IF(LEN(Agent1!" & colStr & "2:" & colStr & "500) + LEN(Agent2!" & colStr & "2:" & colStr & "500) = 0,"""",(IF(Agent1!" & colStr & "2:" & colStr & "500=Agent2!" & colStr & "2:" & colStr & "500, ""YES"", Agent1!" & colStr & "2:" & colStr & "500&""||""&Agent2!" & colStr & "2:" & colStr & "500)))"
Next i
End Sub
Any help would be appreciated : )
Update: I was able to get it working using a combination of the two approaches. Here is the code that works:
For i = 1 To LastColumn
colStr = Replace(Split(Columns(i).Address, ":")(0), "$", "")
With ThisWorkbook.Sheets("Data Validation").Range("A2:A500")
ThisWorkbook.Sheets("Data Validation").Range(colStr & "2:" & colStr & "500").FormulaArray = "=IF(LEN(Agent1!RC:R[498]C)+LEN(Agent2!RC:R[498]C) = 0,"""",(IF(Agent1!RC:R[498]C=Agent2!RC:R[498]C, ""YES"", Agent1!RC:R[498]C&""||""&Agent2!RC:R[498]C)))"
End With
Next i
Thank to everyone for their help!
Try this instead:
Sub MM()
Const LastCol As Integer = 10 '// Column number to extend to
With Sheets("Data Validation").Range("A2:A500")
.Resize(500, LastCol).FormulaArray = "=IF(LEN(Agent1!RC:R[498]C)+LEN(Agent2!RC:R[498]C) = 0,"""",(IF(Agent1!RC:R[498]C=Agent2!RC:R[498]C, ""YES"", Agent1!RC:R[498]C&""||""&Agent2!RC:R[498]C)))"
End With
End Sub
Use R1C1 Notation to make the formula relevant to each cell without looping.
Also, you can use Resize() method to resize an existing range - again, saves looping. Info on Resize method here
Finally, as already mentioned - 99.99% of the time there is no need to .Select anything in vba - you can access an object's properties and methods directly without making it the Selection
From what I see, you're probably selecting the columns of Sheets 'Data Validation' while the active sheet is another worksheet.
You need to activate Data Validations Sheet first which means you add a line
ThisWorkbook.Sheets("Data Validation").Select
before the line
ThisWorkbook.Sheets("Data Validation").Range(colStr & "2:" & colStr & "500").Select
This is provided you don't need to run anymore code which uses the current activesheet.
Related
In excel vba, i am trying to update a cell value based on vlookup on multiple columns. As per the suggestion online i tried using index/match function of vba but somehow it does not works.
ActiveCell.Offset(0, 6) = Application.WorksheetFunction.Index(ExWs.Range("I:I"), _
Application.WorksheetFunction.Match(inv, ExWs.Range("B:B"), 0), _
Application.WorksheetFunction.Match("Planning Readiness Tollgate", ExWs.Range("H:H"), 0) _
, 0)
If in the above code I keep only one conditions things are working fine. Please help !!
Also I am not allowed to update anything on the lookup sheet, it's read only.
Thanks in Advance.
Regards,
Bhavesh Jain
An alternative approach would be to use the Evaluate method. Assuming that Column B contains numerical values, try...
Dim LastRow As Long
With ExWs
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
ActiveCell.Offset(0, 6).Value = Evaluate("INDEX('" & .Name & "'!I2:I" & LastRow & ",MATCH(1,IF('" & .Name & "'!B2:B" & LastRow & "=" & inv & ",IF('" & .Name & "'!H2:H" & LastRow & "=""Planning Readiness Tollgate"",1)),0))")
End With
However, if Column B contains text values, you'll need to enclose the criteria within quotes. If so, try the following instead...
Dim LastRow As Long
With ExWs
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
ActiveCell.Offset(0, 6).Value = Evaluate("INDEX('" & .Name & "'!I2:I" & LastRow & ",MATCH(1,IF('" & .Name & "'!B2:B" & LastRow & "=""" & inv & """,IF('" & .Name & "'!H2:H" & LastRow & "=""Planning Readiness Tollgate"",1)),0))")
End With
Note that the Evaluate method has a 255 character limit.
I am trying to write Range("H" & lastrow) / 4000
let's say lastrow = 150, i have tried H150 it works, however i need the number to be dynamically. So please help me
Range("J" & lastrow).Formula = "=Range"(H & lastrow" / 4000 & ")"
While your initial problem was that you are mixing VBA syntax with Excel formula parameters, I also want to inform you that you might not need to input a formula. In the comments above you mentioned you just want the H150 /4000. The use of a formula seems redundant. Have a look at the two lines of codes below and see the difference.
Sub Test()
Dim lastrow As Long
With ThisWorkbook.Sheets("Sheet1") 'Change sheetname according to yours
lastrow = 150
.Range("J" & lastrow).Formula = "=H" & lastrow & "/4000" 'This will input a formula
.Range("J" & lastrow) = .Range("H" & lastrow) / 4000 'This will input the value directly
End With
End Sub
Now if you have a total that can differ, you can use another variable, e.g.: total to store that value and use in your code.
Sub Test()
Dim lastrow As Long, total as long
With ThisWorkbook.Sheets("Sheet1") 'Change sheetname according to yours
lastrow = 150
total = 100
.Range("J" & lastrow).Formula = "=H" & lastrow & "/" & total 'This will input a formula
.Range("J" & lastrow) = .Range("H" & lastrow) / total'This will input the value directly
End With
End Sub
I think I'm overlooking something simple...
My idea is to create a function in Excel that's easier to set up than the following:
=INDEX($A$1:$A$5,AGGREGATE(15,6,ROW($B$1:$B$5)/($B$1:$B$5=1),ROW(1:1)))
(see ScottCraner's comment in this answer for that function in practice)
I have created the following UDF:
Public Function findUnique(ByVal indexRange As Range, matchRange As Range, matchVal As Long)
' Trying to create a dynamic function of:
' =INDEX($A$1:$A$5,AGGREGATE(15,6,ROW($B$1:$B$5)/($B$1:$B$5=1),ROW(1:1)))
findUnique = Evaluate("=Index(" & indexRange.Address & ",AGGREGATE(15,6,Row(" & matchRange.Address & _
")/(" & matchRange.Address & "=" & matchVal & "),Row(" & ActiveCell.Row & ":" & ActiveCell.Row & ")))")
End Function
And it almost works. Except, when I drag down from the first row, the data doesn't update. I have to click into the cell to "retrigger" the function to get the correct data to show:
(Column D is that formula, entered correctly).
But, how do I get the formula to update automatically, without re-entering the cell?
I've also tried adding a fourth Variable:
Public Function findUnique(ByVal indexRange As Range, matchRange As Range, matchVal As Long, curRow as Long)
findUnique = Evaluate("=Index(" & indexRange.address & ",AGGREGATE(15,6,Row(" & matchRange.address & _
")/(" & matchRange.address & "=" & matchVal & "),Row(" & curRow & ":" & curRow & ")))")
End Function
and enter like: =findUnique($A$1:$A$5,$B$1:$B$5,1,ROW())
but it just returns a #VALUE error
(Also, how do I avoid ActiveCell.Row, as I have it drilled in to my head to avoid using Active anything...)
Thanks for any thoughts or advice!
From this SO answer, try the following ...
With Application.Caller
CallerRow = .Row
End With
findUnique = Evaluate("=Index(" & indexRange.Address & ",AGGREGATE(15,6,Row(" & matchRange.Address & _
")/(" & matchRange.Address & "=" & matchVal & "),Row(" & CallerRow & ":" & CallerRow & ")))")
I am trying to make it easier for users to work with an excel sheet instead of having to modify an arduous expression anytime a change is needed. I am dynamically placing the function's result into a cell. I got everything functioning how it should except:
If I go to another sheet and use the formula, it will return the proper results; however, when returning to another sheet that was already using using it, that sheet will display the most resent results and no longer its own instance of passed variables. These sheets also tie into a dashboard sheet so I need to make sure that if I calculate one sheet, it doesn't tamper with the others. I wasn't sure how to word this issue, so if there is nomenclature in place that I am not using or if this has been answered in the past, let me know and I will close this out.
'-------------------
'getScore
' This function is called from a cell and is passed an intager.
' The integer represents the section that it is being called from.
' There is also the sheet title that is passed thrugh to the range.
'-------------------
Function getScore(section As Integer, sheetTitle As String)
Application.Volatile
Dim rngSt As Integer
Dim rngEnd As Integer
rngSt = getRange(section, sheetTitle, 1) 'Gets start range for formula
rngEnd = getRange(section, sheetTitle, 2) 'Gets end range for formula
Dim Formula As String 'Broken into seperate concatinated lines for readablility
'-(COUNTBLANK(H" & rngSt & ":H" & rngEnd & ")),"
' This section uses nested if statements to acrue the score through each level.
Formula = "=IF(SUM(D" & rngSt & ":D" & rngEnd & ")= nonBlank(D" & rngSt & ":D" & rngEnd & "),"
Formula = Formula & "IF(SUM(F" & rngSt & ":F" & rngEnd & ")= nonBlank(F" & rngSt & ":F" & rngEnd & "),"
Formula = Formula & "IF(SUM(H" & rngSt & ":H" & rngEnd & ")= nonBlank(H" & rngSt & ":H" & rngEnd & "),"
Formula = Formula & "IF(SUM(J" & rngSt & ":J" & rngEnd & ")= nonBlank(J" & rngSt & ":J" & rngEnd & "),"
Formula = Formula & "IF(SUM(L" & rngSt & ":L" & rngEnd & ")= nonBlank(L" & rngSt & ":L" & rngEnd & "),5,4),3),2),1), 0)"
getScore = Eval(Formula) 'Evaluates formula and returns a score of 0-5.
End Function
Here is the getRange fucntion
Function getRange(section As Integer, sheetName As String, rangePoint As Integer)
Application.Volatile
Dim FindRow As Range
Dim ws As Worksheet
Dim wb As Workbook
Set wb = ActiveWorkbook
If section = 1 Then
If rangePoint = 1 Then
With wb.Sheets(sheetName)
Set FindRow = .Range("C9:C9")
End With
getRange = FindRow.Row
End If
If rangePoint = 2 Then
With wb.Sheets(sheetName)
Set FindRow = .Range("C:C").Find(What:="rngEnd", LookIn:=xlValues)
End With
getRange = FindRow.Row - 1
End If
End IF
End Function
Here is my Eval fuction
Function Eval(Ref As String)
Application.Volatile
Eval = Evaluate(Ref)
End Function
nonBlank fucntion
Function nonBlank(r As Range) As Long 'Counts and returns the number of non blank cells found in given range.
Application.Volatile
nonBlank = r.Cells.Count - WorksheetFunction.CountBlank(r)
End Function
In your case, the function is returning exactly what you tell it to. Your UDF has no specification of worksheet anywhere. What you see on the first sheet, after the second sheet calculates, is the returned value of the function, since it calculated on the second sheet. It's a little confusing, so let me try to break it down another way.
You enter a formula with UDF on Sheet1
UDF calculates on Sheet1, with Sheet1 ranges
You navigate to Sheet2 and recalculate UDF entered there
UDF calculates on Sheet2, with Sheet2 ranges
Concurrently on Sheet1 the UDF also calculates, with Sheet2 ranges (this is why you get the same results)
Since calculation doesn't happen when you change sheets, you still see the results calculated correctly.
Bottom line (TL;DR): Your UDF is poorly written.
To help with an answer to your question, please post your getRange function as Scott asked, as well as an example of how you are calling the UDF.
Edit: I see you posted the getRange function, but it's not complete. I think you're missing an End If statement perhaps. Also, your getScore function doesn't compile because you have an extra ">" character in there. Not sure what it's doing in there.
Formula = "=IF(SUM('" & sheetTitle & "'D" & rngSt & ":D" & rngEnd & ")= nonBlank('" & sheetTitle & "'D" & rngSt & ":D" & rngEnd & "),"
Formula = Formula & "IF(SUM('" & sheetTitle & "'F" & rngSt & ":F" & rngEnd & ")= nonBlank('" & sheetTitle & "'F" & rngSt & ":F" & rngEnd & "),"
Formula = Formula & "IF(SUM('" & sheetTitle & "'H" & rngSt & ":H" & rngEnd & ")= nonBlank('" & sheetTitle & "'H" & rngSt & ":H" & rngEnd & "),"
Formula = Formula & "IF(SUM('" & sheetTitle & "'J" & rngSt & ":J" & rngEnd & ")= nonBlank('" & sheetTitle & "'J" & rngSt & ":J" & rngEnd & "),"
Formula = Formula & "IF(SUM('" & sheetTitle & "'L" & rngSt & ":L" & rngEnd & ")= nonBlank('" & sheetTitle & "'L" & rngSt & ":L" & rngEnd & "),5,4),3),2),1), 0)"
Please note this is the quick fix. I wouldn't write a UDF this way. But we would need much more detail if we delve into that.
EDIT: If I understood what you need, this is a much shorter version and should fix the issue you're seeing...
Function Score( _
ByVal Section As Long, _
ByVal Anchor As Range _
) As Long
Dim CheckRange As Range
Application.Volatile True
Set CheckRange = Anchor.Parent.Range("C9", Anchor.Parent.Cells(Anchor.Parent.Rows.Count, "C").End(xlUp))
Score = Abs(CLng(WorksheetFunction.CountA(CheckRange.Offset(0, 1)) = CheckRange.Cells.Count) + _
CLng(WorksheetFunction.CountA(CheckRange.Offset(0, 3)) = CheckRange.Cells.Count) + _
CLng(WorksheetFunction.CountA(CheckRange.Offset(0, 5)) = CheckRange.Cells.Count) + _
CLng(WorksheetFunction.CountA(CheckRange.Offset(0, 7)) = CheckRange.Cells.Count) + _
CLng(WorksheetFunction.CountA(CheckRange.Offset(0, 9)) = CheckRange.Cells.Count))
End Function
You would then call these from any cell like this...
=Score(1,A1)
=Score(1,Sheet2!A1)
=Score(1,'Some other sheet'!A1)
I'm not even sure what the 'Section' variable is for. There isn't much explanation here.
Thanks, Zack Barresse
I have the following code which picks up duplicate rows, however I can not get the code to highlight the duplicates in bold as well as deleting them at the same time.
Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim i As Long
Dim iLastRow As Long
Dim rng As Range
With ActiveSheet
iLastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = 1 To iLastRow
If .Evaluate("SUMPRODUCT(--(A" & i & ":A" & iLastRow & "=A" & i & ")," & _
"--(D" & i & ":D" & iLastRow & "=D" & i & ")," & _
"--(F" & i & ":F" & iLastRow & "=F" & i & ")," & _
"--(J" & i & ":J" & iLastRow & "=J" & i & ")," & _
"--(K" & i & ":K" & iLastRow & "=K" & i & "))") > 1 Then
If rng Is Nothing Then
Set rng = .Cells(i, "A").Resize(, 11)
Else
Set rng = Union(rng, .Cells(i, "A").Resize(, 11))
End If
End If
Next i
**If Not rng Is Nothing Then rng.Delete.font.bold = true**
End With
End Sub
the example of the dataset and desired output can be seen in the following downloadable link below:
https://www.dropbox.com/s/7rhktg6b4nk6ig0/Bold_highlight_Duplicate%20.xlsm
any help would be very much appreciated. Thank you.
Edit:
to clarify, this is how it should look like, just that input shall be deleted and the bold highlighting should appear in the output section:
Instead of **If Not rng Is Nothing Then rng.Delete.font.bold = true** use the following:
If Not rng Is Nothing Then
with rng
.Offset(.Areas(.Areas.Count).Rows(.Areas(.Areas.Count).Rows.Count).Row + 1).Font.Bold = True
.Delete
end with
End If
How this works?
Well, you could have setup the bold indicator while testing for duplicates, however you took a different approach, which does not allow that.
So, your rng is a multiarea selection.
You have to get to the last area, then to the last row of that area, and then retrieve the actual row you're in. Then add +1 for the space between. Now you know how many rows are covered by the input section + the gap to the output and you offset your selection by this count onto the output section.
However, there might be complications, depenting on your input/output - I tested this briefly on your example - worked. Still, I think it would be better to use a different kind of loop & duplicate detection.