Excel Formula in vba? - excel

I am trying to insert the following formula using vba:
Cells(i, 17).Formula = "=IF(""" & Range("M" & i).value & """ = """","""",IFERROR(INDEX(Contacts!$D:$D,MATCH(""*"" & """ & Range("M" & i).value & """ & ""*"",Contacts!$C:$C,0)),"""")"
For some reason i get an application undefined error. Please can someone show me where i am going wrong?

You are missing a )
Cells(i, 17).Formula = "=IF(""" & Range("M" & i).value & """ = """","""",IFERROR(INDEX(Contacts!$D:$D,MATCH(""*"" & """ & Range("M" & i).value & """ & ""*"",Contacts!$C:$C,0)),""""))"

Related

Half the code in my script is giving an error

For i = 2 To 50
ws.Range("K" & i).FormulaLocal = "=if(countif($C$2:C" & i & ";C" & i & ")=1;row();"")"
Next i
ws.Range("K" & i).FormulaLocal = "=if(countif($C$2:C" & i & ";C" & i & ")=1;row();"")
I am getting error on this line. Where am I going wrong?
you need to double the quotation marks within the string (at the end):
ws.Range("K" & i).FormulaLocal = "=if(countif($C$2:C" & i & ";C" & i & ")=1;row();"""")"

How do I change this VBA code from internet explorer to chrome?

I have this code and would like it to convert it to work for chrome instead of IE:
For Each htmlEle In ieObj.Document.getElementsByClassName("data data14902")(0).getElementsByTagName("tr")
With ActiveSheet
.Range("A" & i).Value = htmlEle.Children(0).textContent
.Range("B" & i).Value = htmlEle.Children(1).textContent
.Range("C" & i).Value = htmlEle.Children(2).textContent
.Range("D" & i).Value = htmlEle.Children(3).textContent
.Range("E" & i).Value = htmlEle.Children(4).textContent
.Range("F" & i).Value = htmlEle.Children(5).textContent
.Range("G" & i).Value = htmlEle.Children(6).textContent
.Range("H" & i).Value = htmlEle.Children(7).textContent
.Range("I" & i).Value = htmlEle.Children(8).textContent
.Range("J" & i).Value = htmlEle.Children(9).textContent
.Range("K" & i).Value = htmlEle.Children(10).textContent
.Range("L" & i).Value = htmlEle.Children(11).textContent
End With
i = i + 1
Next htmlEle
This is only a chunk of the code. What I'm doing is navigating to a particular webpage with a data table and what I want to do is copy all the data and paste it into excel.
Also, if there are parts of the code that can be improved, I'm open to it!

Can someone review my excel error and provide feedback on the code?

We have a large excel spreadsheet that has been in use for a view years now, the original coder for it has moved on. Today we started to get an a runtime error "Compile error, Syntax error" highlighting the below code
For n = 7 To lastpivotrow
If Range("AA" & n).Value <> "" And lastpivotrow < 50 Then
Range("B" & nextentry).Value = Range("AB" & n).Value
Range("C" & nextentry).Value = Range("AC" & n).Value
Range("D" & nextentry).Value = Range("AD" & n).Value
Range("E" & nextentry).Value = Range("AE" & n).Value
Range("B" & nextentry, "E" & nextentry).BorderAround LineStyle:=xlContinuous
Range("B" & nextentry, "E" & nextentry).Borders(xlInsideHorizontal).LineStyle = xlContinuous
Range("B" & nextentry, "E" & nextentry).Borders(xlInsideVertical).LineStyle = xlContinuous
Range("B" & nextentr+hen Range("B" & nextentry, "E" & nextentry).Interior.ColorIndex = 39
nextentry = nextentry + 1
Can anyone see whats wrong with this and provide feedback?

Type mismatch error in VBA when using mmult

I am trying to code this forumla in vba.
=MMULT(TRANSPOSE(F124:F370-L124),G124:G370-L125)/246
The code in vba I written looks like this:
Sheets("1.A").Cells(124, 14) = Application.WorksheetFunction.MMult(Application.WorksheetFunction.Transpose(Worksheets("1.A").Range("F" & matchStartRow & ":F" & matchEndRow) - Cells(124, 12)), Worksheets("1.A").Range("G" & matchStartRow & ":G" & matchEndRow) - Cells(125, 12)) / (matchEndRow - matchStartRow)
But it is giving me a type mismatch error. Not sure where it is coming from
It is much easier to use EVALUATE either directly as
Sheets("1.A").Cells(124, 14) = Evaluate("=MMULT(TRANSPOSE(F124:F370-L124),G124:G370-L125)/246")
or with your variables
Dim strEval As String
matchStartRow = 124
matchEndRow = 370
strEval = "=MMULT(TRANSPOSE(F" & matchStartRow & ":F" & matchEndRow & "-L124),G" & matchStartRow & ":G" & matchEndRow & "-L125)/(" & matchEndRow & " - " & matchStartRow & ")"
Sheets("1.A").Cells(124, 14) = Evaluate(strEval)

Could please tell me why this VBA Code is slow. Can excel handle 65 000 row with full of if statements

Why is this code so slow? How to improve speed of excel. What's slowing down code. thanks a lot
Sub setVars()
Set ariba = Worksheets("Ariba Source")
Set kcm = Worksheets("KCM Commitment Report")
Set xdata = Worksheets("Data")
Set mani = Worksheets("Manually Investigate")
Set comm = Worksheets("Commitments")
Set commch = Worksheets("Commitment Changes")
Set test1 = Worksheets("Test") Set test2 = Worksheets("Test2")
End Sub
Call setVars
Dim AribaRows As Long
Dim DataRows As Long
Dim KCMRows As Long
Dim flag As Boolean, flag2 As Boolean, flag3 As Boolean, flag4 As Boolean
Dim l As Long
AribaRows = ariba.Cells(Rows.Count, 4).End(xlUp).Row DataRows = xdata.Cells(Rows.Count, 4).End(xlUp).Row KCMRows = kcm.Cells(Rows.Count, 1).End(xlUp).Row
With xdata For i = 2 To DataRows
.Range("U" & i).NumberFormat = "General"
.Range("O" & i).NumberFormat = "General"
.Range("P" & i).NumberFormat = "General"
.Range("O" & i).Formula = "=IF(MID(B" & i & ",1,2)=""WR"",B" & i & ",TRIM(MID(B" & i & ",1,7)))"
.Range("P" & i).Formula = "=O" & i & "&"".""&C" & i
.Range("Q" & i).Formula = "=IF((O" & i & "<>O" & i - 1 & "),1,IF(C" & i & "=C" & i - 1 & ",Q" & i - 1 & ",Q" & i - 1 & "+1))"
.Range("R" & i).Formula = "=IF(ISNUMBER(0 + MID(E" & i & ",23,3)),LEFT($E" & i & ",25),LEFT($E" & i & ",22))"
.Range("S" & i).Formula = "=IF(LEN(R" & i & ")=25,LEFT(RIGHT(E" & i & ", LEN(E" & i & ")-27),LEN(RIGHT(E" & i & ", LEN(E" & i & ")-27))-1),LEFT(RIGHT(E" & i & ", LEN(E" & i & ")-24),LEN(RIGHT(E" & i & ", LEN(E" & i & ")-24))-1))"
.Range("T" & i).Formula = "=LEFT(F" & i & ", LEN(F" & i & ")-11)"
.Range("U" & i).Formula = "=MID(RIGHT(F" & i & ",9),1,8)"
.Range("V" & i).Formula = "=G" & i
.Range("W" & i).FormulaArray = "=MAX(IF('Ariba Source'!$D$2:$D$" & AribaRows & "&'Ariba Source'!$L$2:$L$" & AribaRows & "&'Ariba Source'!$K$2:$J$" & AribaRows & "=E" & i & "&B" & i & "&D" & i & ",'Ariba Source'!$O$2:$O$" & AribaRows & "))"
.Range("X" & i).Formula = "=IF(ISERROR(DATEVALUE(MONTH(W" & i & ")&"" - ""&DAY(W" & i & ")&"" - ""&YEAR(W" & i & "))),W" & i & ",DATEVALUE(MONTH(W" & i & ")&"" - ""&DAY(W" & i & ")&"" - ""&YEAR(W" & i & ")))"
.Range("Y" & i).Formula = "=IF(INDEX('Ariba Source'!$P$2:$P$" & AribaRows & ",MATCH(E" & i & "&B" & i & "&D" & i & ",INDEX('Ariba Source'!$D$2:$D$" & AribaRows & "&'Ariba Source'!$L$2:$L$" & AribaRows & "&'Ariba Source'!$J$2:$J$" & AribaRows & ",),0))>0,(INDEX('Ariba Source'!$P$2:$P$" & AribaRows & ",MATCH(E" & i & "&B" & i & "&D" & i & ",INDEX('Ariba Source'!$D$2:$D$" & AribaRows & "&'Ariba Source'!$L$2:$L$" & AribaRows & "&'Ariba Source'!$J$2:$J$" & AribaRows & ",),0))/100*INDEX('Ariba Source'!$U$2:$U$" & AribaRows & ",MATCH(E" & i & "&B" & i & "&D" & i & ",INDEX('Ariba Source'!$D$2:$D$" & AribaRows & "&'Ariba Source'!$L$2:$L$" & AribaRows & "&'Ariba Source'!$J$2:$J$" & AribaRows & ",),0)))/SUMIFS('Ariba Source'!$U$2:$U$" & AribaRows & ",'Ariba Source'!$J$2:$J$" & AribaRows & ",D" & i & ",'Ariba Source'!$L$2:$L$" & AribaRows & ",B" & i & "),0)"
.Range("AA" & i).Formula = "=IF(LEFT(B" & i & ",2)=""WR"","""",IF(LEN(R" & i & ")=25,A" & i & "&"".256200.8190000"",A" & i & "&"".251000.1100""))"
.Range("Z" & i).Formula = "=IF(LEFT(B" & i & ",2)=""WR"",0,IF(J" & i & "=""KZT"",N" & i & "*0.08,N" & i & "*0.12))" Next i ' Up to here code works perfect
---------------------------------------#####################
For i = 2 To DataRows If DateValue(.Range("V" & i).Value) >= DateValue(MonthStart) And DateValue(.Range("V" & i).Value) <= DateValue(MonthEnd) Then
l = i - 1
flag2 = True
Do While .Range("A" & i).Value = .Range("A" & l).Value And .Range("O" & i).Value = .Range("O" & l).Value And l > 1
If .Range("R" & i).Value = .Range("R" & l).Value Then
If .Range("C" & i).Value = "03" Then
If .Range("C" & l).Value <> "00" And .Range("C" & l).Value <> "02" Then .Range("AB" & i).Value = "Manually Investigate"
Else
If CInt(.Range("C" & i).Value) > 3 And CInt(.Range("C" & i).Value) - CInt(.Range("C" & l).Value) > 1 Then .Range("AB" & i).Value = "Manually Investigate"
End If
flag2 = False
Exit Do
Else
If Not (.Range("R" & l).Value <> .Range("R" & l + 1).Value And .Range("C" & l).Value = .Range("C" & l + 1).Value And .Range("O" & l).Value = .Range("O" & l + 1).Value) Then
If .Range("C" & i).Value = "03" Then
If .Range("C" & i - 1).Value <> "00" And .Range("C" & i - 1).Value <> "02" Then .Range("AB" & i).Value = "Manually Investigate"
Else
If CInt(.Range("C" & i).Value) > 3 And CInt(.Range("C" & i).Value) - CInt(.Range("C" & i - 1).Value) > 1 Then .Range("AB" & i).Value = "Manually Investigate"
End If
flag2 = False
Exit Do
End If
End If
l = l - 1
Loop
If flag2 Then .Range("AB" & i).Formula = "=IF(AND(C" & i & "<>""00"",C" & i & "<>""02""),""Manually Investigate"","""")"
.Range("AE" & i).Formula = "=IF(AND(K" & i & "=K" & i - 1 & ",O" & i & "<>O" & i - 1 & ",R" & i & "=R" & i - 1 & "),""Manually Investigate"",IF(AND(K" & i & "=K" & i + 1 & ",O" & i & "<>O" & i + 1 & ",R" & i & "=R" & i + 1 & "),""Manually Investigate"",""""))"
If .Range("AE" & i).Value = "Manually Investigate" Then .Range("AE" & i - 1).Value = "Manually Investigate"
If .Range("AC" & i).Value <> "Manually Investigate" Then .Range("AC" & i).Formula = "=IF(AND(COUNTIF('KCM Commitment Report'!$C$2:$C$" & KCMRows & ",O" & i & ")>1,COUNTIFS('KCM Commitment Report'!$A$2:$A$" & KCMRows & ",A" & i & ",'KCM Commitment Report'!$C$2:$C$" & KCMRows & ",O" & i & ",'KCM Commitment Report'!$B$2:$B$" & KCMRows & ",""<>""&R" & i & ",'KCM Commitment Report'!$B$2:$B$" & KCMRows & ",""<>""&A" & i & "&"".256300.8190000"",'KCM Commitment Report'!$B$2:$B$" & KCMRows & ",""<>""&A" & i & "&"".256200.8190000"")>0),""Manually Investigate"","""")"
.Range("AH" & i).Formula = "=IF(AND(COUNTIF('KCM Commitment Report'!$C$2:$C$" & KCMRows & ",O" & i & ")>1,COUNTIFS('KCM Commitment Report'!$A$2:$A$" & KCMRows & ",""<>""&A" & i & ",'KCM Commitment Report'!$C$2:$C$" & KCMRows & ",O" & i & ")>0),""Manually Investigate"","""")"
.Range("AI" & i).Formula = "=IF(AND(J" & i & "<>""USD"",J" & i & "<>""KZT"",J" & i & "<>""EUR"",J" & i & "<>""GBP"",J" & i & "<>""RUB""),""Manually Investigate"","""")"
End If
.Range("AF" & i).Formula = "=IF(OR(I" & i & "=""Closed"",I" & i & "=""Cancelled"",I" & i & "=""Canceling""),""Manually Investigate"","""")"
If .Range("AB" & i).Value = "" And .Range("AC" & i).Value = "" And .Range("AD" & i).Value = "" And .Range("AF" & i).Value = "" Then .Range("AG" & i).Formula = "=IF(IFERROR(MATCH(O" & i & "&""Manually Investigate"",INDEX($O$2:$O$" & DataRows & "&$AC$2:$AC$" & DataRows & ",),0),0)<>0,""Manually Investigate"",IF(IFERROR(MATCH(O" & i & "&""Manually Investigate"",INDEX($O$2:$O$" & DataRows & "&$AD$2:$AD$" & DataRows & ",),0),0)<>0,""Manually Investigate"",IF(IFERROR(MATCH(O" & i & "&""Manually Investigate"",INDEX($O$2:$O$" & DataRows & "&$AB$2:$AB$" & DataRows & ",),0),0)<>0,""Manually Investigate"",IF(IFERROR(MATCH(O" & i & "&""Manually Investigate"",INDEX($O$2:$O$" & DataRows & "&$AF$2:$AF$" & DataRows & ",),0),0)<>0,""Manually Investigate"",""""))))"
.Range("AJ" & i).Formula = "=IF(AB" & i & "=""Manually Investigate"",""Manually Investigate"",IF(AC" & i & "=""Manually Investigate"",""Manually Investigate"",IF(AD" & i & "=""Manually Investigate"",""Manually Investigate"",IF(AE" & i & "=""Manually Investigate"",""Manually Investigate"",IF(AF" & i & "=""Manually Investigate"",""Manually Investigate"",IF(AG" & i & "=""Manually Investigate"",""Manually Investigate"",IF(AH" & i & "=""Manually Investigate"",""Manually Investigate"",IF(AI" & i & "=""Manually Investigate"",""Manually Investigate"",""""))))))))" Next i .Calculate Dim k As Long
Dim st
k = 2 flag = False For i = 2 To DataRows
st = ""
If .Range("AB" & i) = "Manually Investigate" Then st = st + "1,"
If .Range("AC" & i) = "Manually Investigate" Then st = st + "2,"
If .Range("AD" & i) = "Manually Investigate" Then st = st + "3,"
If .Range("AE" & i) = "Manually Investigate" Then st = st + "4,"
If .Range("AF" & i) = "Manually Investigate" Then st = st + "5,"
If .Range("AG" & i) = "Manually Investigate" Then st = st + "6,"
If .Range("AH" & i) = "Manually Investigate" Then st = st + "7,"
If .Range("AI" & i) = "Manually Investigate" Then st = st + "8,"
If .Range("AJ" & i) = "Manually Investigate" Then
st = VBA.Strings.Left(st, Len(st) - 1)
k = k + 1
flag = True
mani.Range("A" & k) = st
mani.Range("C" & k).Value = .Range("A" & i).Value
mani.Range("D" & k).Value = .Range("M" & i).Value
mani.Range("E" & k).Value = .Range("O" & i).Value
mani.Range("F" & k).Value = .Range("P" & i).Value
mani.Range("G" & k).Value = .Range("R" & i).Value
mani.Range("I" & k).Value = .Range("S" & i).Value
mani.Range("J" & k).Value = .Range("V" & i).Value
mani.Range("K" & k).Value = .Range("J" & i).Value
mani.Range("L" & k).Value = .Range("K" & i).Value
mani.Range("M" & k).Value = .Range("N" & i).Value
mani.Range("P" & k).Value = .Range("T" & i).Value
mani.Range("Q" & k).Value = .Range("U" & i).Value
mani.Range("R" & k).Value = .Range("I" & i).Value
mani.Range("S" & k).Value = .Range("H" & i).Value
mani.Range("T" & k).Value = .Range("B" & i).Value
mani.Range("U" & k).Value = .Range("D" & i).Value
mani.Range("V" & k).Value = .Range("C" & i).Value
mani.Range("W" & k).Value = .Range("E" & i).Value
mani.Range("X" & k).Value = .Range("F" & i).Value
End If Next i
i = 2 Do Until i >= DataRows
If VBA.Strings.Left(.Range("B" & i), 2) <> "WR" Then
.Range("A" & i).EntireRow.Copy
.Range("A" & i).Offset(1).EntireRow.Insert
.Range("R" & i).Offset(1).Formula = "=AA" & i
.Range("K" & i).Offset(1).Formula = "=Z" & i
.Range("N" & i).Offset(1).Formula = "=Z" & i
.Range("S" & i).Offset(1).Value = "Freight-All Road incl Rail"
.Range("L" & i).Offset(1).Value = ""
.Range("Z" & i).Offset(1).Value = ""
.Range("AA" & i).Offset(1).Value = ""
i = i + 1
DataRows = DataRows + 1
End If
i = i + 1
Loop
If flag = False Then
Call commitments
Else
mani.Activate
End If
End With
Have you tried to set
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
And after
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
I wonder how the formula calculations will work out when they have been modified by code... and your code is too contextual to what you are doing that I am not going to reverse engineer it to see what you are actually doing.
That little help is all I can provide.
use Option Explicit to make sure there's not a typo in the variables
additional speedup: to save you having to loop through all the values, we can use the fact that excel will adjust the formula as if you had copied it when changing a range.
e.g.
.Range("U2:U" & datarows).NumberFormat = "General"
......
.Range("O2:O" & datarows).Formula = "=IF(MID(B2,1,2)=""WR"",B2,TRIM(MID(B2,1,7)))"
.Range("P2:P" & datarows).Formula = "=O2&"".""&C2"

Resources