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.
Related
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'm copying rows of data from one spreadsheet to another on a button press when cell I says "Yes" and deleting the original row of data. I have multiple ranges I'm copying from the same row, because the second spreadsheet doesn't need all the data held in the first. (first spreadsheet has over 20 columns worth of data but the second has half that). Is there an easy way to make sure this all gets copied to the same row in the new spreadsheet?
Basically what I'm currently doing is copying each of the ranges to the corresponding column in the new spreadsheet with the row number set to being the last used row offset by 1. Which works fine if the previous cells actually have data in, but sometimes they don't (the data is on households and some have more data than others so not all columns are always filled) so the data is placed in a different row from the rest of my data for that particular household.
Private Sub CommandButton1_Click()
Dim c As Range
Dim r As Integer
Dim LastRowD
Dim LastRowR
Dim Database As Worksheet
Dim DeReg As Worksheet
'Set worksheet deignation as needed
Set Database = ActiveWorkbook.Worksheets("Fostering Households")
Set DeReg = ActiveWorkbook.Worksheets("De-Registrations")
LastRowD = Database.Cells(Database.Rows.Count, "A").End(xlUp).Row
'Searches all rows in I
For Each c In Database.Range("I1:I" & LastRowD)
'Catches cases where "Yes" is present in column I
If c = "Yes" Then
LastRowR = Database.Cells(Database.Rows.Count, "A").End(xlUp).Offset(1, 0)
r = c.Row
'Copies the desired column data from rows containing "Yes" from Database tab and pastes it in DeReg tab
Database.Range("A" & r & ":G" & r).Copy DeReg.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
Database.Range("H" & r).Copy DeReg.Range("AJ" & Rows.Count).End(xlUp).Offset(1, 0)
Database.Range("J" & r & ":X" & r).Copy DeReg.Range("H" & Rows.Count).End(xlUp).Offset(1, 0)
Database.Range("AN" & r).Copy DeReg.Range("W" & Rows.Count).End(xlUp).Offset(1, 0)
Database.Range("AS" & r).Copy DeReg.Range("X" & Rows.Count).End(xlUp).Offset(1, 0)
Database.Range("AZ" & r & ":BH" & r).Copy DeReg.Range("Y" & Rows.Count).End(xlUp).Offset(1, 0)
End If
Next c
For i = 250 To 1 Step -1
If Database.Range("I" & i) = "Yes" Then
Database.Rows(i).EntireRow.Delete
End If
Next i
End Sub
I've tried defining the last row based on whether "A" has data in (this is the only cell that is always used) with the code:
LastRowR = Database.Cells(Database.Rows.Count, "A").End(xlUp).Offset(1, 0) and then replacing my copy past code with:
Database.Range("A" & r & ":G" & r).Copy DeReg.Range("A" & LastRowR & ":B" & LastRowR).Row
But this didn't work at all - it copied the first row it found with "Yes" in infinitely and overwrote all the data already present.
I also tried:
Database.Range("A" & r & ":G" & r).Copy DeReg.Range("A" & LastRowR).PasteSpecial
which also came with a world of problems and errors.
What I want is to search for the last used Row based on what's in column A, offset by 1, and then past the data in the column I designate, rather than the last row used being defined by the column I'm trying to paste in - is this even doable? I can't seem to find any information on this particular issue.
Also, if there is a better way of handing multiple ranges that would be great as it seems rather convoluted currently!
DeReg.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) evaluates to:
DeReg.Range("A" & ActiveSheet.Rows.Count).End(xlUp).Offset(1, 0), so unless DeReg is the activesheet, you will get the wrong range.
See if this helps:
.... other code
'LastRowR = Database.Cells(Database.Rows.Count, "A").End(xlUp).Offset(1, 0)
r = c.Row
'Copies the desired column data from rows containing "Yes" from Database tab and pastes it in DeReg tab
With Database
LastRowR = DeReg.Range("A" & DeReg.Rows.Count).End(xlUp).Row + 1
.Range("A" & r & ":G" & r).Copy DeReg.Range("A" & LastRowR)
.Range("H" & r).Copy DeReg.Range("AJ" & LastRowR)
.Range("J" & r & ":X" & r).Copy DeReg.Range("H" & LastRowR)
.Range("AN" & r).Copy DeReg.Range("W" & LastRowR)
.Range("AS" & r).Copy DeReg.Range("X" & LastRowR)
.Range("AZ" & r & ":BH" & r).Copy DeReg.Range("Y" & LastRowR)
End With
End If
... other code
Some helpful tips:
i is not declared. Declare as Long.
LastRowR, r & LastRowD should be declared as Long.
Replace ActiveWorkbook with ThisWorkbook.
The copy paste method used may slow down the program, because this method copies and pastes both values and formatting.
When you want to paste in the line after last row, use +1 (Example: LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row +1
Just a couple thoughts. Firstly, you have declared multiple things that are unnecessary (IMO). I have adjusted your for loop to simply loop through a value that then references the range you want. This way you can use the i value a lot more efficiently than first setting a range and then looping through and referencing the row etc.
Additionally, based on the understanding I get from your post, if you use the .UsedRanged method your outputs will start at the last row on the new sheet, irregardless of your previously chosen method by column. I have not tested the below code, but it should guide you in a clearer way.
Option Explicit
Private Sub CommandButton1_Click()
Dim i As Long
Dim LastRowD As Long
Dim LastRowR As Long
Dim Database As Worksheet
Dim DeReg As Worksheet
'Set worksheet deignation as needed
Set Database = ActiveWorkbook.Worksheets("Fostering Households")
Set DeReg = ActiveWorkbook.Worksheets("De-Registrations")
LastRowD = Database.Cells(Database.Rows.Count, "A").End(xlUp).Row
'Searches all rows in I
For i = 1 To LastRowD
'Catches cases where "Yes" is present in column I
If Database.Range("I" & i) = "Yes" Then
LastRowR = Database.UsedRange.Rows.Count + 1
'Copies the desired column data from rows containing "Yes" from Database tab and pastes it in DeReg tab
Database.Range("A" & i & ":G" & i).Copy DeReg.Range("A" & LastRowR)
Database.Range("H" & i).Copy DeReg.Range("AJ" & LastRowR)
Database.Range("J" & i & ":X" & i).Copy DeReg.Range("H" & LastRowR)
Database.Range("AN" & i).Copy DeReg.Range("W" & LastRowR)
Database.Range("AS" & i).Copy DeReg.Range("X" & LastRowR)
Database.Range("AZ" & i & ":BH" & i).Copy DeReg.Range("Y" & LastRowR)
End If
Next i
For i = 250 To 1 Step -1
If Database.Range("I" & i) = "Yes" Then
Database.Rows(i).EntireRow.Delete
End If
Next i
End Sub
There is a particular part of my code which I cannot make work,
I'm trying to do the following command on VBA =RIGHT(LEFT(X1;Z1-2);LEN(LEFT(X1;Z1-2))-FIND(":";X1))
On cell X1, there is a text: RESULTS:NG & MODEL:IJ
My VBA code is:
LR = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To LR
cel = "A" & i
cel2 = "Y" & i
cel3 = "Z" & i
cel4 = "X" & i
Range("M" & i).Formula = "=RIGHT(LEFT(" & cel4 & "," & cel3 & "-" & 2 & "),LEN(LEFT(" & cel4 & "," & cel3 & "-" & 2 & "))-FIND(:" & cel4 & "))"
Next i
I'm open for a better approach for this issue as well
Thanks in advance
Try writing all the formulas at once and reduce using quotes within the formula as much as possible.
Range(Cells(1, "M"), cells(lr, "M")).Formula = _
"=RIGHT(LEFT(X1, Z1-2), LEN(LEFT(X1, Z1-2))-FIND(char(58), X1))"
All range and cells reference within a sub procedure are better with a properly defined parent worksheet reference.
dim lr as long
with worksheets("sheet1")
LR = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range(.Cells(1, "M"), .cells(lr, "M")).Formula = _
"=RIGHT(LEFT(X1, Z1-2), LEN(LEFT(X1, Z1-2))-FIND(char(58), X1))"
end with
I'm trying to use the Sumif function in VBA, however, I'm getting a run-time error. The error started when I tried to add the variable CritLastCol into the formula. If I replace that with an actual cell reference it works. I want to be able to autofill the rows below this and my criteria will change based on the row. In other words my sum range and criteria range are fixed and my criteria is the cell to the left of my activecell (but not one over, it could be 20, 30 columns over).
Sub SumBydimcode()
Dim lastCol As Integer
Dim CritLastCol As String
lastCol = Cells(3 & Columns.Count).End(xlToLeft).Column
lastRow = Range("A" & Rows.Count).End(xlUp).Row
NewLastRow = Range("I" & Rows.Count).End(xlUp).Row
CritLastCol = ActiveCell.End(xlToLeft).Value
ActiveCell.FormulaR1C1 = "=SUMIF(R3C8:R" & lastRow & "C8," & CritLastCol & ",R3C10:R" & lastRow & "C" & lastCol & ")"
ActiveCell.AutoFill Destination:=Range(ActiveCell.Address & ":J" & NewLastRow)
End Sub
You need to surround your CritLastCol variable in quotation marks. To do so in VBA, you use the double-quote twice "". As a result, your code would look like this:
ActiveCell.FormulaR1C1 = "=SUMIF(R3C8:R" & lastRow & "C8,""" & CritLastCol & """,R3C10:R" & lastRow & "C" & lastCol & ")"
Notice the extra double-quotes surrounding CritLastCol
Ok, I figured out a way to do it... Instead of autofill, I used a loop starting at the end of my data and working back up.
Sub SumBydimcode()
Dim lastCol As Integer
Dim CritLastCol As String
lastCol = Cells(3 & Columns.Count).End(xlToLeft).Column
lastRow = Range("A" & Rows.Count).End(xlUp).Row
NewLastRow = Range("I" & Rows.Count).End(xlUp).Row
NewFirstRow = lastRow + 7
S = ActiveCell.Row
If S > NewLastRow - NewFirstRow Then
For S = ActiveCell.Row To NewFirstRow Step -1
CritLastCol = ActiveCell.End(xlToLeft).Value
ActiveCell.FormulaR1C1 = "=SUMIF(R3C8:R" & lastRow & "C8,""" & CritLastCol & """,R3C10:R" & lastRow & "C" & lastCol & ")"
ActiveCell.Offset(-1, 0).Select
Next S
End If
End Sub
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.