I'm trying to sum multiple columns using vlookup within vba. I can do it as an Excel formula in this manner
{=SUM(VLOOKUP(LookupValue,LookupRange,{FirstColumnNo,2ndColumnNo,...,LastColumnNo},0))}
Within VBA, I don't seem to have any luck using that as I am also using a For loop with this formula. You can sum a lot of these lookups but I'm looking for something shorter and elegant
My current code
For i = 1 To ProdCurrentQtr
''''''''Gross Values
ThisWorkbook.Sheets("Central").Cells(i + 8, 1) = ThisWorkbook.Sheets("Central").Cells(i + 8, 2) & "_" & ThisWorkbook.Sheets("Central").Cells(i + 8, 3)
ThisWorkbook.Sheets("Central").Cells(i + 8, 5) = Application.VLookup(ThisWorkbook.Sheets("Central").Cells(i + 8, 1), LookupRangeCentral, 6, 0) _
+ Application.VLookup(ThisWorkbook.Sheets("Central").Cells(i + 8, 1), LookupRangeCentral, 7, 0) _
+ Application.VLookup(ThisWorkbook.Sheets("Central").Cells(i + 8, 1), LookupRangeCentral, 8, 0) _
+ Application.VLookup(ThisWorkbook.Sheets("Central").Cells(i + 8, 1), LookupRangeCentral, 9, 0) _
+ Application.VLookup(ThisWorkbook.Sheets("Central").Cells(i + 8, 1), LookupRangeCentral, 10, 0) _
+ Application.VLookup(ThisWorkbook.Sheets("Central").Cells(i + 8, 1), LookupRangeCentral, 12, 0)
Next i
But what I'm looking for is something along the lines of
ThisWorkbook.Sheets("Central").Cells(i + 8, 5).FormulaArray = Application.Sum(Application.VLookup(ThisWorkbook.Sheets("Central").Cells(i + 8, 1), LookupRangeCentral, [6,7,8,9,10,12], 0))
Any help appreciated
The following formula does what you want. Just an option:
=SUMPRODUCT(INDEX((ISNUMBER(MATCH(A11:A16,A2:A6&"_"&B2:B6,0)))*(ISNUMBER(SEARCH("," & COLUMN(B11:G16)& ",",",2,4,6,7,")))*B11:G16,))
The ",2,4,6,7," are the actual column numbers, not the relative.
This is summing the values in the above columns where the names are found in A2:A6&"_"&B2:B6.
With ThisWorkbook.Sheets("Central").Cells(8,1)
For i = 1 To ProdCurrentQtr
.Offset(i) = .Offset(i, 1) & "_" & .Offset(i, 2)
Set found = LookupRangeCentral.Find(What:=.Offset(i), LookAt:=xlWhole, LookIn:=xlValues)
If Not found Is Nothing Then .Offset(I, 4) = Application.WorksheetFunction.Sum(found.Offset(,5).Resize(,7)) - found.Offset(,10)
Next i
End With
The array formula approach would be the following
With ThisWorkbook.Sheets("Central").Cells(9,1)
.Resize(ProdCurrentQtr).FormulaR1C1 = "=RC[1] & "" _ "" & RC[2]"
.Offset(,4).FormulaArray = "=SUM(VLOOKUP(" & .Address(False, False) & "," & LookupRangeCentral.Address(,,,True) & ",{6,7,8,9,10,12},0))"
.Offset(,4).AutoFill Destination:=.Offset(,4).Resize(ProdCurrentQtr)
End With
Related
I am trying to join these 3 statements together. I can get two to work but not the third.
Check is looking to see if the 5th character = a,b,c,d.
Check0 is looking to see if characterS 2-9 are all numbers.
Check3 is looking to see if the first 3 characters are numbers.
Desired effect
Before > After
Check 0 e01730101.pdf > S-173-0101
Check3 173d00510.pdf > S-173-D005
Check e173d0061.pdf > S-173-D006
Right now Check0 is not working. When I run the code it seems to skip my Case 13 Check0 statement. Anyway i can write this so the 3 checks are not conflicting each other?
Option Explicit
Sub Convert()
Application.ScreenUpdating = False
Dim rng As Range, aCell As Range
Dim val As String, Check, Check0, Check3
Dim LastRow As Long
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Set rng = Range("A2:A" & LastRow)
For Each aCell In rng.Cells
Select Case Len(aCell)
'Case 12 left out
Case 13
Check = Mid(aCell, 5, Len(aCell) - 12)
If Check = "a" Or Check = "b" Or Check = "c" Or Check = "d" Then 'Existing Standard
val = "S-" & Left(aCell, Len(aCell) - 13) & Mid(aCell, 2, Len(aCell) - 10) & "-" & Mid(aCell, 5, Len(aCell) - 9)
Check0 = IsNumeric(Mid(aCell, 2, Len(aCell) - 5)) '|||PROBLEM|||
ElseIf Check0 = True Then 'Existing Three Line Diagrams
val = "S-" & Left(aCell, Len(aCell) - 10) & "-" & Mid(aCell, 4, Len(aCell) - 9)
End If
Check3 = IsNumeric(Left(aCell, 3))
If Check3 = True Then 'Standard after page 9
val = "S-" & Mid(aCell, 1, Len(aCell) - 10) & "-" & Mid(aCell, 4, Len(aCell) - 9)
End If
Check = ""
Check0 = ""
Check3 = ""
'Case 14 left out
Case Else 'All other pages
val = "_Mod " & Left(aCell, Len(aCell) - 4)
End Select
val = UCase(val)
val = val & " " & aCell.Offset(, 2) & aCell.Offset(, 3)
aCell.Offset(, 1).Value = val
Next
Application.ScreenUpdating = True
End Sub
The issue is that your Check0 variable is not initialised when you check it. It would be best to first do all your three checks and only then perform the If...ElseIf....
Secondly, this expression is using the wrong parts of the input string:
val = "S-" & Left(aCell, Len(aCell) - 10) & "-" & Mid(aCell, 4, Len(aCell) - 9)
I don't really understand why you use Len(aCell) - something, since it is known that the length is 13. Certainly Left(aCell, Len(aCell) - 13) is quite useless, as it will be the empty string.
Here is a correction with some other optimisations (pos is a Long):
Case 13
Check = InStr("abcd", Mid(aCell, 5, 1))
Check0 = IsNumeric(Mid(aCell, 2, 8))
Check3 = IsNumeric(Left(aCell, 3))
pos = IIf(Check3, 1, _
IIf(Check, 2, _
IIf(Check0, 3, 0)))
val = IIf(pos, "S-" & Mid(aCell, pos, 3) & "-" & Mid(aCell, pos+3, 4), "??")
As you might suspect the temp1, temp2 variables change if the user of the programm changes values of cells in Excel, so the range is not constant and function of these variables.
Please Help me as I do not know where the error ( a type mismatch error ) is:
Range(Cells(9, 7 + 2 * temp2 + 1), Cells(8 + temp2, 7 + 2 * temp2 + 1)).Select
Selection.FormulaArray = _
"=MMULT(" & Range(Cells(9, 7 + temp2), Cells(8 + temp2, 7 + 2 * temp2 - 1)) & ",MMULT(TRANSPOSE(" & Range(Cells(9, 6), Cells(9 + temp1, 5 + temp2)) & ")," & Range(Cells(9, 3), Cells(9 + temp1, 3)) & "))"
Without any clue in the question as to what error you are getting, and on which line, I will take a stab in the dark and suggest you are getting an error trying to concatenate a two-dimensional array into a String.
I think you are trying to do:
Range(Cells(9, 7 + 2 * temp2 + 1), Cells(8 + temp2, 7 + 2 * temp2 + 1)).FormulaArray = _
"=MMULT(" & Range(Cells(9, 7 + temp2), Cells(8 + temp2, 7 + 2 * temp2 - 1)).Address & _
",MMULT(TRANSPOSE(" & Range(Cells(9, 6), Cells(9 + temp1, 5 + temp2)).Address & _
")," & Range(Cells(9, 3), Cells(9 + temp1, 3)).Address & "))"
i.e. use the .Address property of your Range objects instead of using the (default) .Value property.
I am essentially trying to match a series of cells from 2 worksheets and obtained values from a corresponding column.
When I run this code, I get an error:
object doesn't support this property or method
My Code
Sub Macro2()
Dim rowcount As Integer
Dim target As Variant
rowcount = Range("E2", Range("E2").End(xlDown)).Count
For i = 1 To rowcount + 1
target = Application.Match(ActiveSheet.Cells(i, 6) & "-" & Cells(i, 5) & "-" & Cells(i, 4) & "-" & Cells(i, 3), Worksheets(14).Range("A6:A3000"), 0)
If ActiveSheet.Cells(i, 6) & "-" & Cells(i, 5) & "-" & Cells(i, 4) & "-" & Cells(i, 3) = _
ActiveSheet.Cells(i + 1, 6) & "-" & Cells(i + 1, 5) & "-" & Cells(i + 1, 4) & "-" & Cells(i + 1, 3) Then
ActiveSheet.Cells(i, 17) = Worksheets(14).target.Offset(0, 10)
End If
Next i
End Sub
If you want to find the Row count, you need to use the syntax:
rowcount = Range(Range("E2"), Range("E2").End(xlDown)).Rows.Count , also it's better to use Long than Integer.
Also, you need to trap a possible error when unable to find a successful match with the Application.Match function, do it by using If Not IsError(target) Then.
Note: try to avoid using ActiveSheet, instead use fully qualified worksheet, by using Worksheets("YourSheetName") in your code.
Code
Sub Macro2()
Dim rowcount As Long
Dim target As Variant
rowcount = Range(Range("E2"), Range("E2").End(xlDown)).Rows.Count
For i = 1 To rowcount + 1
target = Application.Match(ActiveSheet.Cells(i, 6) & "-" & Cells(i, 5) & "-" & Cells(i, 4) & "-" & Cells(i, 3), Worksheets(14).Range("A6:A3000"), 0)
If Not IsError(target) Then ' successful Match
If ActiveSheet.Cells(i, 6) & "-" & Cells(i, 5) & "-" & Cells(i, 4) & "-" & Cells(i, 3) = _
ActiveSheet.Cells(i + 1, 6) & "-" & Cells(i + 1, 5) & "-" & Cells(i + 1, 4) & "-" & Cells(i + 1, 3) Then
ActiveSheet.Cells(i, 17) = Worksheets(14).target.Offset(0, 10)
End If
Else
MsgBox "Unable to find a Match !"
End If
Next i
End Sub
target is not a Property or Method of a Worksheets object.
I believe you need to change Worksheets(14).target.Offset(0, 10) to Worksheets(14).Range("A5").Offset(target, 10).
You should also be consistent in your coding. In your code you have things like ActiveSheet.Cells(i + 1, 6) & "-" & Cells(i + 1, 5) ..., where you specifically qualify Cells(i + 1, 6) to be on ActiveSheet but allow Cells(i + 1, 5) to default to being on the ActiveSheet. Although it works, it will get very confusing if you ever need to reread your code later on.
I want to put this If in a macro but it gives me an error all the time. I dont know if "Or" is used correctly or not.
Dim SMAT As String
SMAT = "blahblahblah"
(...)
If Cells(h + 2, 24) <> SMAT Or SMBE Or SMES Or SMFR Or SMGB Or SMGR Or SMRO1 Or SMRO2 Or SMRO3 Or SMDE Then
C(j) = Cells(h + 2, 5)
Use a Select Case block instead:
Select Case Cells(H + 2, 24).Value
Case SMAT, SMBE, SMES, SMFR, SMGB, SMGR, SMR01, SMR02, SMR03, SMDE
Case Else
c(j) = Cells(H + 2, 5).Value
End Select
Or another way using Evaluate(), just for variety*:
varConditions = Array(SMAT, SMBE, SMES, SMFR, SMGB, SMGR, SMR01, SMR02, SMR03, SMDE)
If Evaluate("ISERROR(MATCH(" & Cells(H + 2, 24).Value & ",{" & _
Join(varConditions, ",") & "},0))") Then
c(j) = Cells(H + 2, 5).Value
End If
* This Evaluate method will work when the array contains numbers - if you are using strings you would have to wrap each string in additional quotation marks
Here is the correction
Dim SMAT As String
SMAT = "blahblahblah"
'(...)
If Cells(H + 2, 24) <> SMAT Or _
Cells(H + 2, 24) <> SMBE Or _
Cells(H + 2, 24) <> SMES Or _
Cells(H + 2, 24) <> SMFR Or _
Cells(H + 2, 24) <> SMGB Or _
Cells(H + 2, 24) <> SMGR Or _
Cells(H + 2, 24) <> SMRO1 Or _
Cells(H + 2, 24) <> SMRO2 Or _
Cells(H + 2, 24) <> SMRO3 Or _
Cells(H + 2, 24) <> SMDE Then
c(j) = Cells(H + 2, 5)
End If
Or Operator (Visual Basic)
The error is because you are trying to "talk" to VBA like a person do, but the or does not take the parameter of another or. You need to tell in every parameter of each or to tell the complete logical test
firstCheck = a > b Or b > c
firstCheck = Logical_test Or Logical_test
A macro (not mine though, I "inherited" it) runs multiple loops. The code has a couple of thousands lines so I will provide only the wonky part of the loop in the snippet.
Dim repoLastRow As Integer, repoLastCol As Integer
Worksheets("ATT_LEV").Activate
With ActiveSheet
repoLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
repoLastCol = ActiveSheet.Cells(3, Columns.Count).End(xlToLeft).Column
Cells(repoLastRow + 1, 1).Value = xmlAgreement1
Cells(repoLastRow + 1, 2).Value = repoLastRow + 1
Cells(repoLastRow + 1, 5).Value = pubCurrCNID
Cells(repoLastRow + 1, 4).Formula = "=IF(IFERROR(FIND(""MASTER"",'Import xml 0'!A2,1),0)>0,""MASTER"",IF(IFERROR(FIND(""ANNEX"",'Import xml 0'!A2,1),0)>0,""ANNEX"",""""))"
Cells(repoLastRow + 1, 4).Value = Cells(repoLastRow + 1, 4).Value
Range(Cells(repoLastRow + 1, 3), Cells(repoLastRow + 1, repoLastCol)).Dirty
For i = 5 To repoLastCol
column_letter = Split(Columns(i + 1).Address, ":")(0)
Cells(repoLastRow + 1, i + 1).Formula = "=IFERROR(IF(VLOOKUP(" & column_letter & "1&" & column_letter & "2,CompareSingle!$A:$I,9,FALSE)=0,"""",VLOOKUP(" & column_letter & "1&" & column_letter & "2,CompareSingle!$A:$I,8,FALSE)),"""")"
Cells(repoLastRow + 1, i + 2).Formula = "=IFERROR(IF(VLOOKUP(" & column_letter & "1&" & column_letter & "2,CompareSingle!$A:$I,9,FALSE)=0,"""",VLOOKUP(" & column_letter & "1&" & column_letter & "2,CompareSingle!$A:$I,9,FALSE)),"""")"
i = i + 1
Next i
Range(Cells(repoLastRow + 1, 3), Cells(repoLastRow + 1, 3)).Formula = "=CompareSingle!C1"
Range(Cells(repoLastRow + 1, 3), Cells(repoLastRow + 1, repoLastCol)).Value = _
Range(Cells(repoLastRow + 1, 3), Cells(repoLastRow + 1, repoLastCol)).Value
This is the specific part that crashes.
Range(Cells(repoLastRow + 1, 3), Cells(repoLastRow + 1, repoLastCol)).Value = _
Range(Cells(repoLastRow + 1, 3), Cells(repoLastRow + 1, repoLastCol)).Value
The thing is that this specific line gives me the '1004 application-defined or object-defined error' but only after a couple of iterations of the loop, let's say after 40. So for the 41st time macro goes through this part of the code, it simply breaks. Sometimes it is almost 50 times it loops flawlessly, but ultimately it will always crash - and I've never made more than 50 loops. Sometimes it ends up with a complete Excel freeze, but more often it's just a debugger pop-up. Funny thing is that if I stop the macro and start it from the loop at which it crashed, it will go through this statement smoothly and will break again after another couple dozen passages. The funniest thing is, however, it always breaks on this line only in the whole macro although a similar pattern (.value=.value) is successfully applied in other parts of the macro (similar range, similar sheets, similar type of data).
I thought a workaround for the buggy part would be the following:
Range(Cells(repoLastRow + 1, 3), Cells(repoLastRow + 1, repoLastCol)).Copy
Range(Cells(repoLastRow + 1, 3), Cells(repoLastRow + 1, 3)).PasteSpecial xlPasteValues
Application.CutCopyMode = False
but instead I'm receiving '1004 PasteSpecial method of Range class failed' (after some time of course, initially it works OK too). Also tried .Value2=.Value2, but same crap.
I mentioned that after stopping the macro and running it anew from the last correct loop it goes OK. That's true, but after the crash on this line Excel usually becomes sort of unresponsive to VBA calls and I'm only able to proceed after I save, quit and reopen the worksheet. For example,Worksheet.Activate method has no effect (nothing happens, the called worksheet doesn't get activated) or Cells.Clear doesn't work either and renders an error. After reopening the workbook all is back to normal and I can run the procedure. The macro is stored in an .xlsb if that matters, was created and run in Excel 2010 (initially in .xlsm).
Anyone might have an idea why this keeps happening? And why at random?
PS. I realize the code might not be optimized (e.g. you might pick on the Worsksheet.Activate method used) but, again, this is sth I've been given to work with and I'd rather not rewrite the code, at least for now, unless necessary to make it work.
EDIT
I have solved my problem, at least partially. What I did is convert the cell to values immediately after it has been populated with formula and now I can loop forever:
For i = 5 To repoLastCol
column_letter = Split(Columns(i + 1).Address, ":")(0)
Cells(repoLastRow + 1, i + 1).Formula = "=IFERROR(IF(VLOOKUP(" & column_letter & "1&" & column_letter & "2,CompareSingle!$A:$I,9,FALSE)=0,"""",VLOOKUP(" & column_letter & "1&" & column_letter & "2,CompareSingle!$A:$I,8,FALSE)),"""")"
Cells(repoLastRow + 1, i + 1).Value = Cells(repoLastRow + 1, i + 1).Value
Cells(repoLastRow + 1, i + 2).Formula = "=IFERROR(IF(VLOOKUP(" & column_letter & "1&" & column_letter & "2,CompareSingle!$A:$I,9,FALSE)=0,"""",VLOOKUP(" & column_letter & "1&" & column_letter & "2,CompareSingle!$A:$I,9,FALSE)),"""")"
Cells(repoLastRow + 1, i + 2).Value = Cells(repoLastRow + 1, i + 2).Value
i = i + 1
Next i
I'm not entirely satisfied with this workaround because it still doesn't explain what's causing the error. You might find it interesting but over the last couple of runs the error happened exactly at 40th loop (and of course always at the same line). When excel crashed(on some occasions) I tried to debug it with Visual Studio and once got info that problem is with VBE7.dll.
Any guesses as to the nature of the problem?
You are referencing the parent worksheet correctly with,
With ActiveSheet
repoLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Why stop there? The With ... End With statement is your biggest friend for assigning (and maintaining) the parent worksheet.
Row number and column number assignments should always be Long, not Integer no matter how much 'cooler' Integer sounds.
Dim repoLastRow As Long, repoLastCol As Long
With Worksheets("ATT_LEV")
.Activate
repoLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
repoLastCol = .Cells(3, Columns.Count).End(xlToLeft).Column
.Cells(repoLastRow + 1, 1).Value = xmlAgreement1
.Cells(repoLastRow + 1, 2).Value = repoLastRow + 1
.Cells(repoLastRow + 1, 5).Value = pubCurrCNID
.Cells(repoLastRow + 1, 4).Formula = "=IF(IFERROR(FIND(""MASTER"",'Import xml 0'!A2,1),0)>0,""MASTER"",IF(IFERROR(FIND(""ANNEX"",'Import xml 0'!A2,1),0)>0,""ANNEX"",""""))"
.Cells(repoLastRow + 1, 4).Value = Cells(repoLastRow + 1, 4).Value
.Range(.Cells(repoLastRow + 1, 3), .Cells(repoLastRow + 1, repoLastCol)).Dirty
For i = 5 To repoLastCol
column_letter = Split(.Columns(i + 1).Address, ":")(0)
.Cells(repoLastRow + 1, i + 1).Formula = "=IFERROR(IF(VLOOKUP(" & column_letter & "1&" & column_letter & "2,CompareSingle!$A:$I,9,FALSE)=0,"""",VLOOKUP(" & column_letter & "1&" & column_letter & "2,CompareSingle!$A:$I,8,FALSE)),"""")"
.Cells(repoLastRow + 1, i + 2).Formula = "=IFERROR(IF(VLOOKUP(" & column_letter & "1&" & column_letter & "2,CompareSingle!$A:$I,9,FALSE)=0,"""",VLOOKUP(" & column_letter & "1&" & column_letter & "2,CompareSingle!$A:$I,9,FALSE)),"""")"
i = i + 1
Next i
.Range(.Cells(repoLastRow + 1, 3), .Cells(repoLastRow + 1, 3)).Formula = "=CompareSingle!C1"
.Range(.Cells(repoLastRow + 1, 3), .Cells(repoLastRow + 1, repoLastCol)) = _
.Range(.Cells(repoLastRow + 1, 3), .Cells(repoLastRow + 1, repoLastCol)).Value
End With