thanks in advance for taking the time to help. I have built a Do While loop in VBA that for some reason breaks when j = 1. I have in cells C3:C7 these values: 13,14,14,13,14.
Here's the short script:
Dim i, j, n As Integer
Dim List(0) As Integer
i = o
j = 0
n = 0
Do While Cells(i + 3, 3) <> ""
If Cells(i + 3, 3) > 13 Then
List(j) = i + 3
j = j + 1
Cells(i + 3, 4) = "Noted"
i = i + 1
ElseIf Cells(i + 3, 3) = 13 Then
Cells(i + 3, 4) = "Skipped"
i = i + 1
Else
i = i + 1
End If
Loop
For n = j To n = 0
Rows(List(n)).Delete
Next
Thanks again!
Your intent is sound, but there are quite a few errors. See commented code below for details
Sub Demo()
' ~~ must explicitly type each variable. Use Long
Dim i As Long, j As Long, n As Long
Dim List() As Long '<~~ dynamic array
i = 3 '<~~ eliminate the klunky +3
j = 0
n = 0
ReDim List(0 To 0) '<~~ initialise dynamic array
Do While Cells(i, 3) <> vbNullString
If Cells(i, 3) > 13 Then
ReDim Preserve List(0 To j) '<~~ resize array
List(j) = i
j = j + 1
Cells(i, 4) = "Noted"
ElseIf Cells(i, 3) = 13 Then
Cells(i, 4) = "Skipped"
End If
i = i + 1 '<~~ simplify, its called in each if case anyway
Loop
' j will end up 1 greater than size of array
If j > 0 Then '<~~ only execute if we found some rows to delete
For n = j - 1 To 0 Step -1 '<~~ For loop syntax
Rows(List(n)).Delete
Next
End If
End Sub
Related
I have two Strings in different cells for example
ADSGPINDTDANPR
RGTELDDGIQADSGPINDTDANPRY VPGYY ESQSDDPHFHEK
Also character sequences can have gaps for similar sequences like RGX in following example
LADNS TFDDDLDDLTPSKMKPANFKGD
RSLA FDDDLDDLTPSRGXKMKPANFKGDYG
What I want to do is Highlight both the sequences as shown in above example in Bold And Italic but in color using VBA code.
Edit :
As per the first answer of #milo5m
Sequence is highlighted as follows
MNTVEEVDSEEDEESAP GSV GSMPSTGSAKYYTNRVPFDMIA
EQPMNTVEEVDSEEDEESAPA
But desired result should be like this:
MNTVEEVDSEEDEESAP GSV GSMPSTGSAKYYTNRVPFDMIA
EQPMNTVEEVDSEEDEESAPA
Edit 2 :
Currently answer of #milo5m highlights single characters as shown in below examples
SKPERYSG
TAPGEQAQD
SKPERYSG
AQD QKLAPSE
In above examples no sequence should have been highlighted...
In other words, It should only highlight the Single characters when there is space before the Character, otherwise it should not highlight single characters between sequences.
It's really nice that we have these two as a reference
https://www.sciencedirect.com/science/article/pii/S0890540114000765
https://en.wikipedia.org/wiki/Longest_common_subsequence_problem
Here is the main function which is returning all subsequences forming the LCS (if you join all the keys you get the LCS in reverse subsequence form).
Function returns a dictionary where keys are subsequences, and values are arrays with 2 elements (position of subsequence in seqA and position of subsequence in seqB).
Function GetLCSSubSequenceDict(seqA As String, seqB As String) As Object
Set GetLCSSubSequenceDict = Nothing
Dim i As Long, n As Long
n = Len(seqA)
If n = 0 Then: Exit Function
Dim j As Long, m As Long
m = Len(seqB)
If m = 0 Then: Exit Function
Dim T() As Long
ReDim T(0 To n, 0 To m)
'Building up table
For i = 1 To n
For j = 1 To m
If Mid$(seqA, i, 1) <> Mid$(seqB, j, 1) Then
'bitwise max
T(i, j) = T(i - 1, j) Xor ((T(i - 1, j) Xor T(i, j - 1)) And --(T(i - 1, j) < T(i, j - 1)))
Else
T(i, j) = T(i - 1, j - 1) + 1
End If
Next j
Next i
Dim subseqKey As String
Dim subseqABDict As Object
Set subseqABDict = CreateObject("Scripting.Dictionary")
'Backtracking and building up dict of subsequences
'key = subsequence
'value = array(starting pos of the key in seqA,starting pos of the key in seqB)
i = n
j = m
Do While (i > 0 And j > 0)
If Not Mid$(seqA, i, 1) <> Mid$(seqB, j, 1) Then
subseqKey = Mid$(seqA, i, 1) & subseqKey
i = i - 1
j = j - 1
ElseIf T(i - 1, j) > T(i, j - 1) Then
If subseqKey <> vbNullString Then
subseqABDict(subseqKey) = Array(i + 1, j + 1)
subseqKey = vbNullString
End If
i = i - 1
Else
If subseqKey <> vbNullString Then
subseqABDict(subseqKey) = Array(i + 1, j + 1)
subseqKey = vbNullString
End If
j = j - 1
End If
Loop
If subseqKey <> vbNullString Then
subseqABDict(subseqKey) = Array(i + 1, j + 1)
End If
Set GetLCSSubSequenceDict = subseqABDict
Set subseqABDict = Nothing
End Function
Time complexity of the function is O ( Len(seqA) * Len(seqB) ), for those who are interested.
Following is a show case of setting font properties on 2 ranges seqA and seqB.
Sub test()
Dim seqA As Range
Dim seqB As Range
Set seqA = Range("A4")
Set seqB = Range("B4")
Dim fontColor As Long
fontColor = RGB(84, 84, 84)
Dim subseqKey As Variant
Dim lcsSubSequenceDict As Object
Set lcsSubSequenceDict = GetLCSSubSequenceDict(seqA.Value2, seqB.Value2)
'gives subsequences in reversed order, since we used backtracking
'MsgBox Join(lcsSubSequenceDict.keys())
If lcsSubSequenceDict Is Nothing Then: Exit Sub
For Each subseqKey In lcsSubSequenceDict
With seqA.Characters(lcsSubSequenceDict(subseqKey)(0), Len(subseqKey)).Font
.color = fontColor
.Bold = True
.Italic = True
End With
With seqB.Characters(lcsSubSequenceDict(subseqKey)(1), Len(subseqKey)).Font
.color = fontColor
.Bold = True
.Italic = True
End With
Next subseqKey
Set lcsSubSequenceDict = Nothing
Set seqA = Nothing
Set seqB = Nothing
End Sub
Edit:
(1) Fixed - Backtracking showing positions in sequences further to the right for multiple candidates
(2) Main Function returns Collection now (was returning Dictionary)
Function GetLCSSubSequenceCollection(seqA As String, seqB As String) As Collection
Set GetLCSSubSequenceCollection = Nothing
Dim i As Long, n As Long
n = Len(seqA)
If n = 0 Then: Exit Function
Dim j As Long, m As Long
m = Len(seqB)
If m = 0 Then: Exit Function
Dim T() As Long
ReDim T(0 To n, 0 To m)
'Building up table
For i = 1 To n
For j = 1 To m
If Mid$(seqA, i, 1) <> Mid$(seqB, j, 1) Then
'bitwise max
T(i, j) = T(i - 1, j) Xor ((T(i - 1, j) Xor T(i, j - 1)) And --(T(i - 1, j) < T(i, j - 1)))
Else
T(i, j) = T(i - 1, j - 1) + 1
End If
Next j
Next i
Dim subseqKey As String
Dim subseqABCollection As Collection
Set subseqABCollection = New Collection
'Backtracking and building up collection of subsequences
'value = array(subsequence, starting pos of the key in seqA,starting pos of the key in seqB)
i = n
j = m
Do While (i > 0 And j > 0)
If Not Mid$(seqA, i, 1) <> Mid$(seqB, j, 1) Then
subseqKey = Mid$(seqA, i, 1) & subseqKey
i = i - 1
j = j - 1
ElseIf T(i - 1, j) > T(i, j - 1) Then
If subseqKey <> vbNullString Then
subseqABCollection.Add Array(subseqKey, i + 1, j + 1)
subseqKey = vbNullString
End If
i = i - 1
Else
If subseqKey <> vbNullString Then
subseqABCollection.Add Array(subseqKey, i + 1, j + 1)
subseqKey = vbNullString
End If
j = j - 1
End If
Loop
If subseqKey <> vbNullString Then
subseqABCollection.Add Array(subseqKey, i + 1, j + 1)
End If
If subseqABCollection.Count = 0 Then: Exit Function
'fix backtracking showing positions in arrays further to the right for multiple candidates
'using inStr to chack starting from prev position etc
Dim prevSubseqPosA As Long, prevSubseqPosB As Long
prevSubseqPosA = 1
prevSubseqPosB = 1
Set GetLCSSubSequenceCollection = New Collection
For i = subseqABCollection.Count To 1 Step -1
subseqKey = subseqABCollection.Item(i)(0)
prevSubseqPosA = InStr(prevSubseqPosA, seqA, subseqKey)
prevSubseqPosB = InStr(prevSubseqPosB, seqB, subseqKey)
GetLCSSubSequenceCollection.Add Array(subseqKey, prevSubseqPosA, prevSubseqPosB)
prevSubseqPosA = prevSubseqPosA + Len(subseqKey)
prevSubseqPosB = prevSubseqPosB + Len(subseqKey)
Next
Set subseqABCollection = Nothing
End Function
Sub testCollection()
Dim lcs As String
Dim seqA As Range
Dim seqB As Range
Set seqA = Range("A4")
Set seqB = Range("B4")
Dim fontColor As Long
fontColor = RGB(84, 84, 84)
Dim lcsSubSequenceItem As Variant
Dim lcsSubSequenceCollection As Collection
Set lcsSubSequenceCollection = GetLCSSubSequenceCollection(seqA.Value2, seqB.Value2)
If lcsSubSequenceCollection Is Nothing Then: Exit Sub
For Each lcsSubSequenceItem In lcsSubSequenceCollection
With seqA.Characters(lcsSubSequenceItem(1), Len(lcsSubSequenceItem(0))).Font
.color = fontColor
.Bold = True
.Italic = True
End With
With seqB.Characters(lcsSubSequenceItem(2), Len(lcsSubSequenceItem(0))).Font
.color = fontColor
.Bold = True
.Italic = True
End With
lcs = lcs & lcsSubSequenceItem(0)
Next lcsSubSequenceItem
MsgBox lcs & " [ LEN = " & Len(lcs) & " ]"
Set lcsSubSequenceCollection = Nothing
Set seqA = Nothing
Set seqB = Nothing
End Sub
Tough challenge, and I'm not sure if it's that feasible with Excel alone. Assuming that:
You will not allow the 1st entry to have gaps;
You allow for 0+ gaps in between in the 2nd entry;
You are looking for the longest match between both entries;
You have ms365;
You may try the below answer that I based of on a formula first, see the below screenshot:
Formula in C1:
=LET(x,SCAN(,UNIQUE(TOCOL(MID(A1,SEQUENCE(LEN(A1)),SEQUENCE(1,LEN(A1))))),LAMBDA(a,b,TEXTJOIN("*",,MID(b,SEQUENCE(1,LEN(b)),1)))),y,SEARCH(x,B1),z,SORTBY(HSTACK(x,y),LEN(x)*(ISNUMBER(y)),-1),SUBSTITUTE(TAKE(FILTER(z,ISNUMBER(INDEX(z,,2))),1,1),"*",))
The above will identify the longest substring that has a match with 0+ gaps in between. This is going to be the input to the below macro:
Sub Test()
Dim ws As Worksheet, lr As Long, x As Long, y As Long, z As Long, a As Long, arr As Variant, s As String
Set ws = ThisWorkbook.Worksheets("Sheet1")
lr = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
arr = ws.Range("A1:C" & lr)
For x = LBound(arr) To UBound(arr)
s = arr(x, 3)
'Format column A:A
ws.Cells(x, 1).Characters(InStr(1, ws.Cells(x, 1).Value, s), Len(s)).Font.Bold = True
ws.Cells(x, 1).Characters(InStr(1, ws.Cells(x, 1).Value, s), Len(s)).Font.Italic = True
'Format column B:B
z = 0
For y = 1 To Len(s)
z = InStr(z + 1, ws.Cells(x, 2).Value, Mid(s, y, 1))
ws.Cells(x, 2).Characters(z, 1).Font.Bold = True
ws.Cells(x, 2).Characters(z, 1).Font.Italic = True
Next
Next
End Sub
The results look like:
I have a worksheet with over 60,000 rows and two columns. One column is transaction id, the other is item. I want to find the combinations of items in the orders. I found this vba code from someone with a similar problem
Sub basket()
On Error Resume Next
Dim ps(2, 20)
r = 3
tr = Cells(2, 1)
Item = Cells(2, 2) + "."
ps(1, 1) = 1
ps(2, 1) = Len(Item)
r2 = 2
r3 = 3
ic = 2
While Cells(r, 1) <> ""
If Cells(r, 1) <> tr Then
o = 1
k = 1
If ic > 1 Then
ic = ic - 1
While o = 1
For i = 1 To ic
entry = Mid(Item, ps(1, i), ps(2, i))
For j = i + k To ic
entry = entry & Mid(Item, ps(1, j), ps(2, j))
Cells(r2, 10) = tr
Cells(r2, 11) = entry
r2 = r2 + 1
x = 0
x = Application.WorksheetFunction.Match(entry, Range("e:e"), 0)
If x = 0 Then
x = r3
Cells(x, 5) = entry
r3 = r3 + 1
End If
Cells(x, 6) = Cells(x, 6) + 1
Next j
Next i
If k > Len(Item) - 1 Then o = 0
k = k + 1
Wend
End If
Item = ""
ic = 1
tr = Cells(r, 1)
End If
ps(1, ic) = Len(Item) + 1
ps(2, ic) = Len(Cells(r, 2)) + 1
Item = Item + Cells(r, 2) + "."
r = r + 1
ic = ic + 1
Wend
o = 1
k = 1
If ic > 1 Then
ic = ic - 1
While o = 1
For i = 1 To ic
entry = Mid(Item, ps(1, i), ps(2, i))
For j = i + k To ic
entry = entry & Mid(Item, ps(1, j), ps(2, j))
Cells(r2, 10) = tr
Cells(r2, 11) = entry
r2 = r2 + 1
x = 0
x = Application.WorksheetFunction.Match(entry, Range("e:e"), 0)
If x = 0 Then
x = r3
Cells(x, 5) = entry
r3 = r3 + 1
End If
Cells(x, 6) = Cells(x, 6) + 1
Next j
Next i
If k > Len(Item) - 1 Then o = 0
k = k + 1
Wend
End If
End Sub
Which worked when I ran the exact same code but with item categories. The problem is I'm running it with the item names and it's always crashing my Excel. Is there anyone that can guide me in the right direction?
this is the worksheet that doesn't work
this is what I get when I run it with the item category which works. They're the exact same data, one just has it as item category, and the other is item name.
Your code sample didn't do anything for me. It ran, but it didn't actually produce any kind of results at all. I did a quick Google search and found this.
Sub ListCombinations()
Dim col As New Collection
Dim c As Range, sht As Worksheet, res
Dim i As Long, arr, numCols As Long
Set sht = ActiveSheet
'lists begin in A1, B1, C1, D1
For Each c In sht.Range("A2:B2").Cells
col.Add Application.Transpose(sht.Range(c, c.End(xlDown)))
numCols = numCols + 1
Next c
res = Combine(col, "~~")
For i = 0 To UBound(res)
arr = Split(res(i), "~~")
sht.Range("H1").Offset(i, 0).Resize(1, numCols) = arr
Next i
End Sub
'create combinations from a collection of string arrays
Function Combine(col As Collection, SEP As String) As String()
Dim rv() As String
Dim pos() As Long, lengths() As Long, lbs() As Long, ubs() As Long
Dim t As Long, i As Long, n As Long, ub As Long
Dim numIn As Long, s As String, r As Long
numIn = col.Count
ReDim pos(1 To numIn)
ReDim lbs(1 To numIn)
ReDim ubs(1 To numIn)
ReDim lengths(1 To numIn)
t = 0
For i = 1 To numIn 'calculate # of combinations, and cache bounds/lengths
lbs(i) = LBound(col(i))
ubs(i) = UBound(col(i))
lengths(i) = (ubs(i) - lbs(i)) + 1
pos(i) = lbs(i)
t = IIf(t = 0, lengths(i), t * lengths(i))
Next i
ReDim rv(0 To t - 1) 'resize destination array
For n = 0 To (t - 1)
s = ""
For i = 1 To numIn
s = s & IIf(Len(s) > 0, SEP, "") & col(i)(pos(i)) 'build the string
Next i
rv(n) = s
For i = numIn To 1 Step -1
If pos(i) <> ubs(i) Then 'Not done all of this array yet...
pos(i) = pos(i) + 1 'Increment array index
For r = i + 1 To numIn 'Reset all the indexes
pos(r) = lbs(r) ' of the later arrays
Next r
Exit For
End If
Next i
Next n
Combine = rv
End Function
I found that from this link.
VBA - Write all possible combinations of 4 columns of data
I'm pretty sure if you do some more Googling, you can find other concepts that do pretty much the same thing.
I'm having trouble with the if statement inside a loop. Every time I try and run it, it gives me an error of:
next without for
Sub CheckDates4()
Dim count As Integer
Dim i As Integer
Dim j As Integer
count = 0
i = 2
j = 24
For i = 2 To 318
For j = 46 To 1 Step (-2)
If Sheet1.Cells(i, j) >= Sheet2.Cells(1, 1) And Sheet1.Cells(i, j - 1) = "Reçu" Then
count = count + 1
Next i
Next j
End If
Sheet2.Cells(1, 7) = count
End Sub
Any ideas how to fix this?
You should first close the If condition with End If. Then, close the inner For loop with Next j. Finally, close the outer For loop with Next i. So, your code should look like this:
Sub CheckDates4()
Dim count As Integer
Dim i As Integer
Dim j As Integer
count = 0
i = 2
j = 24
For i = 2 To 318
For j = 46 To 1 Step (-2)
If Sheet1.Cells(i, j) >= Sheet2.Cells(1, 1) And Sheet1.Cells(i, j - 1) = "Reçu" Then
count = count + 1
End If
Next j
Next i
Sheet2.Cells(1, 7) = count
End Sub
Your END IF was in the wrong place and you've swapped your NEXTs as well:
For i = 2 To 318
For j = 46 To 1 Step (-2)
If Sheet1.Cells(i, j) >= Sheet2.Cells(1, 1) And Sheet1.Cells(i, j - 1) = "Reçu" Then
count = count + 1
End If
Next
Next
I have challenges in highlighting/copying alternate rows in one column and pasting it to the next column and aligned.
Here's a screenshot:
Following code assumes you have two separate tabs, SRC and DST and the range of data starts in the first cell. Will do all in a single step:
Public Sub CopyAlternate()
Dim i As Long
i = 2
While Len(Sheets("SRC").Cells(i, 1).Value) > 0
Sheets("DST").Cells(i / 2 + 1, 1).Value = Sheets("SRC").Cells(i, 1).Value
Sheets("DST").Cells(i / 2 + 1, 2).Value = Sheets("SRC").Cells(i + 1, 1).Value
i = i + 2
Wend
End Sub
You can take this code and adjust it to taste:
Sub alternate()
Dim i As Integer
Dim j As Integer
Dim n As Integer
i = 0
j = 0
n = 0
With ActiveSheet
For Each c In .Range("A4:A16")
.Cells(20 + j, 1 + i).Value = c.Value
If n = 0 Or n Mod 2 = 0 Then
i = 1
j = j
Else
i = 0
j = j + 1
End If
n = n + 1
Next c
End With
End Sub
This worked for me when rebuilding your example with letters (for faster checking).
Function calculateIO(ByVal reachName As String, ByVal natFlow As Double, ByVal IOTableWorksheet As Worksheet, ByVal weeklyDate As Date) As Double
Dim rowNoReach, rowToNextTable, columnNo, rowNo, startColumn, columnCounter, rowCounter, rowCounter1, dateCounter As Integer
Dim vlookupRange As Range
Dim vlookupResult As Double
Dim currentDay, currentMonth As Integer
Dim differenceCal As Double
Dim ansStorage 'where to store the natural flow value from the IO table that is used to obtain the corresponding IO
Dim IOvalue As Double
differenceCal = 1000000
currentDay = day(weeklyDate)
currentMonth = month(weeklyDate)
'Format the reach name if it is a mainstem reach name.
If (InStr(reachName, "Mainstem") > 0) Then reachName = Trim(Split(reachName, "-")(1))
'Initializes the row pointers
rowNoReach = 0
rowToNextTable = 1
startColumn = 1
'It is assumed that there is no IO until one is found
calculateIO = -1
'Loop through each IO table until there an IO table is not found
Do While (rowToNextTable <> 0)
rowNoReach = rowNoReach + rowToNextTable
rowToNextTable = IOTableWorksheet.Cells(rowNoReach, 14).value
'This will compare the reach name with the IO table name. if they are a match then an IO will be calculated using this IO table.
If (InStr(IOTableWorksheet.Cells(rowNoReach, 2).value, reachName) > 0) Then
If ((currentMonth <= 3) Or (currentMonth >= 11)) Then
columnCounter = 1
For columnCounter = 1 To 21
If ((month(IOTableWorksheet.Cells(rowNoReach + 2, columnCounter)) = currentMonth) And (day(IOTableWorksheet.Cells(rowNoReach + 2, i)) = currentDay)) Then
calculateIO = IOTableWorksheet.Cells(rowNoReach + 3, columnCounter).value
Exit Function
End If
Next columnCounter
'looking through the table
ElseIf ((currentMonth >= 4) Or (currentMonth <= 10)) Then
columnCounter = 1
Do While IsDate(IOTableWorksheet.Cells(rowNoReach + 5, columnCounter))
If ((day(weeklyDate) = day(IOTableWorksheet.Cells(rowNoReach + 5, columnCounter))) And (month(weeklyDate) = month(IOTableWorksheet.Cells(rowNoReach + 5, columnCounter)))) Then
startColumn = columnCounter
End If
columnCounter = columnCounter + 1
Loop
If (natFlow < IOTableWorksheet.Cells(rowNoReach + 6, startColumn)) Then
calculateIO = natFlow
Exit Function
ElseIf (natFlow > IOTableWorksheet.Cells(rowNoReach + 6, startColumn)) Then
rowCounter1 = 0
For rowCounter1 = 0 To IOTableWorksheet.Range(IOTableWorksheet.Cells(rowNoReach + 6, startColumn), IOTableWorksheet.Range(IOTableWorksheet.Cells(rowNoReach + 6, startColumn).End(xlDown))).Rows.Count - 1
If (difference > (natFlow - IOTableWorksheet.Cells(rowNoReach + rowCounter1, startColumn))) Then
If (natFlow - IOTableWorksheet.Cells(rowNoReach + rowCounter1, startColumn)) < 0 Then
calculateIO = IOvalue
Exit Function
End If
difference = natFlow - IOTableWorksheet.Cells(rowNoReach + rowCounter1, startColumn)
IOvalue = IOTableWorksheet.Cells(rowNoReach + rowCounter1, 32)
End If
calculateIO = IOvalue
Exit Function
End If
End If
ElseIf (IOTableWorksheet.Cells(rowNoReach, 2).value = "Minimum Or Established IO") Then
'Initialize row and column pointers
rowNo = rowNoReach + 3
columnNo = 2
'Calculate the row and column number
Do While (InStr(reachName, IOTableWorksheet.Cells(rowNoReach + 2, columnNo).value) = 0 And Not IsEmpty(IOTableWorksheet.Cells(rowNoReach + 2, columnNo).value)): columnNo = columnNo + 1: Loop
Do While (month(IOTableWorksheet.Cells(rowNo, 1).value) <> month(weeklyDate) Or day(IOTableWorksheet.Cells(rowNo, 1).value) <> day(weeklyDate)): rowNo = rowNo + 1: Loop
'Get the IO value from the table if the reach was in the table
If Not IsEmpty(IOTableWorksheet.Cells(rowNo, columnNo).value) Then calculateIO = IOTableWorksheet.Cells(rowNo, columnNo): Exit Function
ElseIf (IOTableWorksheet.Cells(rowNoReach, 2).value = "Single IO Streams") Then
'Initialize row and column pointers
rowNo = rowNoReach + 3
columnNo = 2
'Calculate the column number
Do While InStr(reachName, IOTableWorksheet.Cells(rowNoReach + 2, columnNo).value) = 0 And Not IsEmpty(IOTableWorksheet.Cells(rowNoReach + 2, columnNo).value): columnNo = columnNo + 1: Loop
'Get the IO value from the table if the reach was in the table
If Not IsEmpty(IOTableWorksheet.Cells(rowNo, columnNo).value) Then calculateIO = IOTableWorksheet.Cells(rowNo, columnNo): Exit Function
End If
Loop 'looping through the first do while loop
End Function
no idea why the code keeps on having this compiling error, I have basically looked through by identifying each End If statement with the corresponding If-ElseIF-Else statement and no extra End If should be in here. Also I have properly indented the code.