xpathstring
="/html/body/div[2]/section[2]/section/section/div/div[2]/div[1]/div[1]/div[1]/div[2]/div/div/table/tbody"
j = 1
trcnt = 1
For Each ele In cd.FindElementsByClass("CI-GRID-EVEN")
dataArr(j, 1) = ele.FindElementByXPath("" + xpathstring + "/tr[trcnt]/td[1]").Text
'Debug.Print dataArr(j, 1); trcnt; j
dataArr(j, 2) = ele.FindElementByXPath("" + xpathstring + "/tr[trcnt]/td[5]").Text
dataArr(j, 3) = ele.FindElementByXPath("" + xpathstring + "/tr[trcnt]/td[2]").Text
j = j + 1
trcnt = trcnt + 2
Next ele
There is no error for tr[1], but error in using variable like tr[trcnt] in findelementsbyxpath.
I think instead of "/tr[trcnt] you want "/tr[" + trcnt + "]"
Related
I need to modify a for-loop, so that it skips to the next iteration when it does not find an object. Here is a snippet:
For j = 0 To i - 1
Proj = Cells(3 + j, 2).Value
ResClass = Cells(3 + j, 3).Value
Set project = resq.Projects.Item(Proj)
Set class = project.ReservingClasses(ResClass)
Set CFP = class.Vectors("Cashflow DFM JM").Method
Set CFPvol5 = class.Vectors("Cashflow DFM JM vol5").Method
Set CFPTr = class.Vectors("Cashflow DFM JM Tr").Method
orig = project.OriginCount
For k = 1 To orig
Cells(20 - 3, 4) = "DFM JM"
Cells(20 - 3, 4).Font.Bold = True
Cells(20 + k, col) = CFP.CashFlowPeriodLabel(k) - orig
Cells(20 - 2, col) = Cells(3 + j, 1).Value
Cells(20 - 2, col).Font.Bold = True
Cells(20 - 1, col + 1) = CFP.CashFlowPeriodLabel(1)
Cells(20 + k, col + 1) = Round(CFP.DiscountedCashflows(k, 1), 0)
Cells(20 - 1, col + 2) = CFP.CashFlowPeriodLabel(2)
Cells(20 + k, col + 2) = Round(CFP.DiscountedCashflows(k, 2), 0)
Cells(59 - 3, 4) = "DFM Paid vol5"
Cells(59 - 3, 4).Font.Bold = True
Cells(59 + k, col) = CFPvol5.CashFlowPeriodLabel(k) - orig
Cells(59 - 2, col) = Cells(3 + j, 1).Value
Cells(59 - 2, col).Font.Bold = True
Cells(59 - 1, col + 1) = CFPvol5.CashFlowPeriodLabel(1)
Cells(59 + k, col + 1) = Round(CFPvol5.DiscountedCashflows(k, 1), 0)
Cells(59 - 1, col + 2) = CFPvol5.CashFlowPeriodLabel(2)
Cells(59 + k, col + 2) = Round(CFPvol5.DiscountedCashflows(k, 2), 0)
Cells(98 - 3, 4) = "DFM JM Tr"
Cells(98 - 3, 4).Font.Bold = True
Cells(98 + k, col) = CFPTr.CashFlowPeriodLabel(k) - orig
Cells(98 - 2, col) = Cells(3 + j, 1).Value
Cells(98 - 2, col).Font.Bold = True
Cells(98 - 1, col + 1) = CFPTr.CashFlowPeriodLabel(1)
Cells(98 + k, col + 1) = Round(CFPTr.DiscountedCashflows(k, 1), 0)
Cells(98 - 1, col + 2) = CFPTr.CashFlowPeriodLabel(2)
Cells(98 + k, col + 2) = Round(CFPTr.DiscountedCashflows(k, 2), 0)
Next k
col = col + 4
Next
If for a certain j in the first for-loop there is no CFPvol5 in the second for-loop, then the procedure stops with an error. I want the procedure to continue with the next block, in this case with CFPTr. Is this possible? And if yes, how?
Thank you very much for your help!
Shown 2 methods: Just a sample.
on error resume next
For i = 1 to x
'do your stuff here
next
on error goto 0
or
on error goto nextLoop
for i = 1 to x
' do your stuff here
nextLoop:
next
NumberFormat seems to be a straightforward function but I can't get it to work is a rather simple case. In the code below VBA tells me "Type Mismatch".
For j = 1 To last_column + 1
For f = 2 To total_tranches + 1
If allocation(f - 1, j - 1) = Empty And j <> 1 Then
Allo1.Cells(AlShares.Row - 1 + f, j + 1) = 0
Else
Allo1.Cells(AlShares.Row - 1 + f, j + 1) = allocation(f - 1, j - 1)
If j = 1 Then Allo1.Cells(AlShares.Row - 1 + f, j + 1).IndentLevel = 1
If j = 2 Then Allo1.Cells(AlShares.Row - 1 + f, j + 1).NumberFormat = "_($*#,##0_);_($*(#,##0);_($*" - "??_);_(#_)"
End If
Next f
Next j
And if I replace specific formatting with "Accounting" it just does not work. Please help!
You are asking VBA to subtract 2 strings "...($*" - "??_.." so that is the type mismatch.
I have a for loop that takes a user's input and one of the keys in my dictionary and passes them to a Damerau-Levenshtein function and based on the distance, overwrites the user's input with the dictionary key (The for loop is to cycle through each dictionary key). This works fine enough for strings larger than three characters, but if the string is three or fewer characters the algorithm returns with the wrong key. Here's the for loop:
1950 For j = 0 To dict.Count - 1
1960 distance = DamerauLevenshtein(SplitStr(i), dict.Keys(j))
1970 'MsgBox dict.Keys(j) & vbCrLf & distance ' used for debugging
1980 If distance < 4 Then
1990 If distance < leastDist Then
2000 leastDist = distance
2010 SplitStr(i) = dict.Keys(j)
2020 End If
2030 End If
2040 Next
2050 MsgBox "The distance is: " & leastDist & vbCrLf & "The entered text was " & tempStr & vbCrLf & "The replaced word is " & SplitStr(i)
SplitStr(i) holds the user's input, which comes from a split function. I arbitrarily picked 4 for a good distance
I stole the algorithm from a bytes.com forum post. Algorithm below:
Function DamerauLevenshtein(str1, str2, Optional intSize = 256)
Dim intTotalLen, arrDistance, intLen1, intLen2, i, j, arrStr1, arrStr2, arrDA, intMini
Dim intDB, intI1, intJ1, intD
str1 = UCase(str1)
str2 = UCase(str2)
intLen1 = Len(str1)
intLen2 = Len(str2)
intTotalLen = intLen1 + intLen2
ReDim arrStr1(intLen1)
ReDim arrStr2(intLen2)
ReDim arrDA(intSize)
ReDim arrDistance(intLen1 + 2, intLen2 + 2)
arrDistance(0, 0) = intTotalLen
For i = 0 To intSize - 1
arrDA(i) = 0
Next
For i = 0 To intLen1
arrDistance(i + 1, 1) = i
arrDistance(i + 1, 0) = intTotalLen
Next
For i = 1 To intLen1
arrStr1(i - 1) = Asc(Mid(str1, i, 1))
Next
For j = 0 To intLen2
arrDistance(1, j + 1) = j
arrDistance(0, j + 1) = intTotalLen
Next
For j = 1 To intLen2
arrStr2(j - 1) = Asc(Mid(str2, j, 1))
Next
For i = 1 To intLen1
intDB = 0
For j = 1 To intLen2
intI1 = arrDA(arrStr2(j - 1))
intJ1 = intDB
If arrStr1(i - 1) = arrStr2(j - 1) Then
intD = 0
Else
intD = 1
End If
If intD = 0 Then intDB = j
intMini = arrDistance(i, j) + intD
If intMini > arrDistance(i + 1, j) + 1 Then intMini = arrDistance(i + 1, j) + 1
If intMini > arrDistance(i, j + 1) + 1 Then intMini = arrDistance(i, j + 1) + 1
If intMini > arrDistance(intI1, intJ1) + i - intI1 + j - intJ1 - 1 Then intMini = arrDistance(intI1, intJ1) + i - intI1 + j - intJ1 - 1
arrDistance(i + 1, j + 1) = intMini
Next
arrDA(arrStr1(i - 1)) = i
Next
DamerauLevenshtein = arrDistance(intLen1 + 1, intLen2 + 1)
End Function
If I type in "Cire" the algorithm correctly returns "CORE".
"Raman" returns "REMAN"
"Cosnigned" returns "CONSIGNED
However, "Now" should return "New" but returns "OCM".
"New" also returns "OCM" (so distance should be 0, but is 2.)
"FP" should be "FP" but returns "OCM", distance is 2
"DPF" Should be "DPF" but returns "OCM", distance is 2
I just learned about the algorithm, so I'm sure I'm missing something important, but I just can't see it. Thoughts?
I figured it out. After much searching I found a post saying that an edit distance is commonly 2. (They didn't specify any merits on why 2 is common)
I switched my if statement to 2 from 4 and now all of the problem terms are being corrected as they should be.
I am trying to edit some VBA code which currently loops until a certain test is met. What I would like to do is loop until two conditions are met. I am having trouble getting it do so. Here is the original code, which works.
Loop
For j = 1 To 29
Increment = Worksheets("Price & Energy Curve").Cells(8 + Start + j, 3).Value
l = Int((Worksheets("Capacity").Cells(57 + j, 12).Value) * (-1) / Increment)
k = WorksheetFunction.Max((l + 1) * Increment, 0)
Worksheets("Capacity").Activate
ActiveSheet.Cells(56 + j, 17).Value = k
test = ActiveSheet.Cells(57 + j, 13).Value
Do While test <> True
k = k + Increment
ActiveSheet.Cells(56 + j, 17).Value = k
test = ActiveSheet.Cells(57 + j, 13).Value
Loop
Next j
I would like to add the additional test of
test = ActiveSheet.Cells(57 + j, 37).Value
So that when
test = ActiveSheet.Cells(57 + j, 13).Value
and
test = ActiveSheet.Cells(57 + j, 37).Value
are true, the loop exits.
Check this loop
Do While test1 <> True Or test2 <> True
k = k + Increment
ActiveSheet.Cells(56 + j, 17).Value = k
test1 = ActiveSheet.Cells(57 + j, 13).Value
test2 = ActiveSheet.Cells(57 + j, 37).Value
Loop
When I run the code below I get the annoying 1004 error.
Sub TEST_MACRO()
Dim shSource As Worksheet
Dim shDest As Worksheet
Dim DateRange As Range
Dim i As Integer, nullcounter As Integer, nullcounterov As Integer, tablelength As Integer, tablelengthov As Integer, DateRangeSize As Integer
Dim q As Integer
Set shSource = ThisWorkbook.Sheets("Sheet1")
Set shDest = ThisWorkbook.Sheets("Sheet2")
Set DateRange = shSource.Application.InputBox("Select date", Type:=8)
DateRangeSize = DateRange.Rows.Count
nullcounter = 0
nullcounterov = 0
tablelength = 3
tablelengthov = 3
For q = 0 To DateRangeSize - 1
shDest.Range("C4:I17").ClearContents
'THIS IS THE CODE FOR ABC
For i = 0 To 3
If IsEmpty(shSource.Cells(DateRange.Row + q, 2 + i)) = True Or shSource.Cells(DateRange.Row + q, 2 + i) = 0 Then
nullcounter = nullcounter + 1
Else
shDest.Cells(4 + i - nullcounter, 4) = shSource.Cells(DateRange.Row + q, 2 + i)
shDest.Cells(4 + i - nullcounter, 5) = shSource.Cells(DateRange.Row + q, 6 + i)
shDest.Cells(4 + i - nullcounter, 3) = shSource.Cells(1, 2 + i)
tablelength = tablelength + 1
End If
Next
'THIS IS THE CODE FOR XYZ
For i = 0 To 6
If IsEmpty(shSource.Cells(DateRange.Row + q, 10 + i)) = True Or shSource.Cells(DateRange.Row + q, 10 + i) = 0 Then
nullcounterov = nullcounterov + 1
Else
shDest.Cells(4 + i - nullcounterov, 8) = shSource.Cells(DateRange.Row + q, 10 + i)
shDest.Cells(4 + i - nullcounterov, 9) = shSource.Cells(DateRange.Row + q, 17 + i)
shDest.Cells(4 + i - nullcounterov, 7) = shSource.Cells(1, 10 + i)
tablelengthov = tablelengthov + 1
End If
Next
Next
End Sub
The excel sheet I run this on looks like this:
http://i.imgur.com/V7tWTKq.png
The code works for ABC but it doesn't for XYZ. I'm guessing the 0 value cells are messing it up but I don't understand why.
The goal of the code is:
User is prompted to select a range of size DateRangeSize.
For each row in the range the code copies the values of ABC, ABC-D, XYZ and XYZ-D if they aren't 0 and writes them to sheet 2.
If the number of rows in the range is 1, the code works fine. But if the number of rows is greater than 1, I get the 1004 error where this part of the code is highlight:
shDest.Cells(4 + i - nullcounterov, 8) = shSource.Cells(DateRange.Row + q, 10 + i)
I appreciate the help.
EDIT: I just want to add that the code ALWAYS works for ABC. If the number of rows is 2 then the ABC values for the second row are printed in sheet2 but the code breaks when it attempts to do the same for XYZ.
EDIT 2: I added 0 values to the ABC portion but the code still works for ABC! This is so frustrating.
I figured it out. I defined
nullcounter = 0
nullcounterov = 0
tablelength = 3
tablelengthov = 3
Outside of the loop so they kept on increasing.
shDest.Cells(4 + i - nullcounterov, 8) = shSource.Cells(DateRange.Row + q, 10 + i)
Eventually 4 + i << nullcounterov and excel tried to write to a cell that didn't exist.
The fixed code:
Sub TEST_MACRO()
Dim shSource As Worksheet
Dim shDest As Worksheet
Dim DateRange As Range
Dim i As Integer, nullcounter As Integer, nullcounterov As Integer, tablelength As Integer, tablelengthov As Integer, DateRangeSize As Integer
Dim q As Integer
Set shSource = ThisWorkbook.Sheets("Sheet1")
Set shDest = ThisWorkbook.Sheets("Sheet2")
Set DateRange = shSource.Application.InputBox("Select date", Type:=8)
DateRangeSize = DateRange.Rows.Count
For q = 0 To DateRangeSize - 1
nullcounter = 0
nullcounterov = 0
tablelength = 3
tablelengthov = 3
shDest.Range("C4:I17").ClearContents
'THIS IS THE CODE FOR ABC
For i = 0 To 3
If IsEmpty(shSource.Cells(DateRange.Row + q, 2 + i)) = True Or shSource.Cells(DateRange.Row + q, 2 + i) = 0 Then
nullcounter = nullcounter + 1
Else
shDest.Cells(4 + i - nullcounter, 4) = shSource.Cells(DateRange.Row + q, 2 + i)
shDest.Cells(4 + i - nullcounter, 5) = shSource.Cells(DateRange.Row + q, 6 + i)
shDest.Cells(4 + i - nullcounter, 3) = shSource.Cells(1, 2 + i)
tablelength = tablelength + 1
End If
Next
'THIS IS THE CODE FOR XYZ
For i = 0 To 6
If IsEmpty(shSource.Cells(DateRange.Row + q, 10 + i)) = True Or shSource.Cells(DateRange.Row + q, 10 + i) = 0 Then
nullcounterov = nullcounterov + 1
Else
shDest.Cells(4 + i - nullcounterov, 8) = shSource.Cells(DateRange.Row + q, 10 + i)
shDest.Cells(4 + i - nullcounterov, 9) = shSource.Cells(DateRange.Row + q, 17 + i)
shDest.Cells(4 + i - nullcounterov, 7) = shSource.Cells(1, 10 + i)
tablelengthov = tablelengthov + 1
End If
Next
Next
End Sub