When G is passed to below code it returns 1 instead of 7. Can anyone point me in the right direction please? I'm trying to get the Excel column index from the column letter. Thank you
Public Function ColLetterToColIndex(colLetter As String) As Integer
colLetter = colLetter.ToUpper()
Dim sum As Integer = 0
For i As Integer = 0 To colLetter.Length - 1
sum *= 26
Dim charA As Integer = Char.GetNumericValue("A")
Dim charColLetter As Integer = Char.GetNumericValue(colLetter(i))
sum += (charColLetter - charA) + 1
Next
Return sum
End Function
Try this (instead of GetNumericValue):
Dim charA As Integer = Asc("A")
Dim charColLetter As Integer = Asc(colLetter)
Everything else can stay the same.
Related
I have in Column K:
K8 is 6384 i.e. =SUM(J1:J8)
K9 is 2598 i.e. =SUM(J2:J9)
K10 is 12176 i.e =SUM(J3:J10)
:
:
K5488
up to K5488 (No numbers in sequence, all different numbers)
The largest number appearing in K is 1 400 000.
I need in Column M: The prime factors of each number in K
e.g. K8 is 6384 then M8 should be 2,2,2,2,3,7,19
k9 is 2598 then M9 should be 2,3,433 etc.
I found the following code by John Coleman on your site (Mar 28) which tested well, but seeing I have no programming knowledge, I don't know how to modify it to use in my columns K & M setup.
Here's the sample code:
Function Factor(ByVal n As Long, Optional FirstTrial As Long = 2) As String
Dim i As Long
Dim t As Long
Dim limit As Long
Dim rest As String
Dim s As String
If n = 1 Then
Factor = n
Exit Function
End If
limit = Int(Sqr(n))
t = FirstTrial
Do While t <= limit
If n Mod t = 0 Then
rest = Factor(n / t, t)
If rest <> "1" Then
s = t & "," & rest
End If
Factor = s
Exit Function
Else
If t = 2 Then t = 3 Else t = t + 2
End If
Loop
'if we get here:
Factor = n
End Function
Function PrimeOrFactor(n As Long) As String
Dim s As String
s = Factor(n)
If n = 1 Then
PrimeOrFactor = "Neither"
ElseIf (s) = Trim(n) Then
PrimeOrFactor = "Prime"
Else
PrimeOrFactor = s
End If
End Function
Tested like:
Sub test()
Dim i As Long
For i = 1 To 20
Cells(i, 1) = i
Cells(i, 2) = PrimeOrFactor(i)
Next i
End Sub
The function you provided is a udf (user defined function) to be used in your worksheet.
If you put the functions you provided in a normal code module, you can enter the following in your worksheet in M8:
=Factor(K8)
and copy that function down to your desired range.
Hi there I'm hoping someone here can help me out.
I've got some pretty untidy data and I am looking to do a VLOOKUP / INDEX MATCH sort of function but having no luck as the data is quite untidy.
So basically I've got a list of names and there websites in one sheet.
Then a second sheet with just a list of names that I want to populate with the websites from the other sheet as to cut down the work load.
The problem is the company names are not entered in the correct format (i.e for an abbreviated company spaces are used instead of .'s). Another example is when there is multiple branches of a company.
So worksheet 1 would be
Company Name: Company
Website: www.company.com
Worksheet 2 would be:
Company Name : Company (UK)
Company Name : Company (USA)
Where both should have the same website as found in worksheet 1 is there any possible way to do this. I have tried VLOOKUP and INDEX/MATCH and set the condition to TRUE but it does not return good results.
Thanks in advance for any advice.
Fuzzy matching is a far from an exact science, particularly when it comes to the built in Excel functions.
If I was to recommend the safest bet - I would say create a de-duped list of the values in sheet 2 and create a matching lookup value for sheet one. This would certainly be the most accurate (but time consuming and depending on how many times you will use these values)
Alternatively, there are 'fuzzy matches' from various sources that can be used. One of the famous ones is the 'Jaro Winkler Distance' : a version of which can be found at this link: http://garonfolo.dk/herbert/2013/07/excel-vba-jaro-winkler-distance-fuzzy-matching/
Without seeing the data it's impossible to say for sure, but here are some options.
1. You could use MATCH("*Company*",Sheets1!A:A,0).
2. If there is always the same pattern, you could create a helper column using LEFT, RIGHT, and MID to extract the company name.
3. VBA offers some support for regular expressions, using Set reg = CreateObject("VBScript.RegExp") If you know how to use regular expressions, you could write a macro to match based on it.
To expand on the answer by Trum because the link he posted is no longer available, I have translated the JaroWinklerProximity algorithm found in this C# implementation https://stackoverflow.com/a/19165108/8031589 by user leebickmtu to VBA for Excel:
Option Base 1
Function JaroWinklerProximity(String1 As Range, String2 As Range) As Double
Dim mWeightThreshold As Double
mWeightThreshold = 0.7
Dim mNumChars As Integer
mNumChars = 4
Dim aString1 As String
aString1 = LCase(String1.Text)
Dim aString2 As String
aString2 = LCase(String2.Text)
Dim lLen1 As Integer
lLen1 = Len(aString1)
Dim lLen2 As Integer
lLen2 = Len(aString2)
If lLen1 = 0 Then
If lLen2 = 0 Then
JaroWinklerProximity = 1
Exit Function
Else
JaroWinklerProximity = 0
Exit Function
End If
End If
Dim lSearchRange As Integer
lSearchRange = WorksheetFunction.Max(1, WorksheetFunction.Max(lLen1, lLen2) / 2)
ReDim lMatched1(lLen1) As Boolean
ReDim lMatched2(lLen2) As Boolean
Dim lNumCommon As Integer
lNumCommon = 0
Dim i As Integer
For i = 1 To lLen1 Step 1
Dim lStart As Integer
lStart = WorksheetFunction.Max(1, i - lSearchRange)
Dim lEnd As Integer
lEnd = WorksheetFunction.Min(i + lSearchRange, lLen2)
Dim j As Integer
For j = lStart To lEnd - 1 Step 1
If lMatched2(j) Then
GoTo NextIteration1
End If
Dim charAtIndex1 As String
charAtIndex1 = Mid(aString1, i, 1)
Dim charAtIndex2 As String
charAtIndex2 = Mid(aString2, j, 1)
If charAtIndex1 <> charAtIndex2 Then
GoTo NextIteration1
End If
lMatched1(i) = True
lMatched2(j) = True
lNumCommon = lNumCommon + 1
Exit For
NextIteration1:
Next j
Next i
If lNumCommon = 0 Then
JaroWinklerProximity = 0
Exit Function
End If
Dim lNumHalfTransposed As Integer
lNumHalfTransposed = 0
Dim k As Integer
k = 1
For i = 1 To lLen1 Step 1
If Not lMatched1(i) Then
GoTo NextIteration2
End If
Do While Not lMatched2(k)
k = k + 1
Loop
If Mid(aString1, i, 1) <> Mid(aString2, j, 1) Then
lNumHalfTransposed = lNumHalfTransposed + 1
End If
k = k + 1
NextIteration2:
Next
Dim lNumTransposed As Integer
lNumTransposed = lNumHalfTransposed / 2
Dim lNumCommonD As Double
lNumCommonD = lNumCommon
Dim lWeight As Double
lWeight = (lNumCommonD / lLen1 + lNumCommonD / lLen2 + (lNumCommon - lNumTransposed) / lNumCommonD) / 3
If lWeight <= mWeightThreshold Then
JaroWinklerProximity = lWeight
Exit Function
End If
Dim lMax As Integer
lMax = WorksheetFunction.Min(mNumChars, WorksheetFunction.Min(Len(aString1), Len(aString2)))
Dim lPos As Integer
lPos = 1
Do While lPos < lMax And Mid(aString1, lPos, 1) = Mid(aString2, lPos, 1)
lPos = lPos + 1
Loop
If lPos = 1 Then
JaroWinklerProximity = lWeight
Exit Function
End If
JaroWinklerProximity = lWeight + 0.1 * lPos * (1# - lWeight)
End Function
Take a look at the following code. What my problem is is that I can't figure out how to redimension the n integer and the b integer. What I'm doing is the array sent1 is already working and it is populated with about 4 sentences. I need to go through each sentence and work on it but I'm having trouble.
dim sent1()
dim sent2()
dim n as integer, b as integer, x as integer
dim temp_sent as string
b = 0
For n = 1 to ubound(sent1)
temp_sent = sent1(n)
for x = 1 to len(temp_sent1)
code
if a then
b = b + 1
'**THIS IS THE PART OF THE CODE THAT IS NOT WORKING**
redim preserve sent2(1 to ubound(sent1), b)
sent2(n,b) = [code]
next
next
There are two issues in your code:
When you Dim an array without specifying the lower bound it will by default be 0 based (unless you have specified Option Base 1). When explicitly specified, lower bound can be any number, not just 0 or 1
For a multi dimensioned array, Redim Preserve can only change the last dimension, and then only the upper bound.
In general, I find it better to always specify Lower and Upper bounds, eg
Redim MyArray(1 to 10, 0 to 99)
Is there any specific reason why you want to / must use arrays?
If not, I'd suggest using collections instead. You can also have nested collections, e.g.
Dim dimension1 As New Collection
Dim dimension2 AS New Collection
dimension1.Add dimension2
etc.
That way, you won't have to worry about increasing dimensions manually at all. If you need to convert it back to a 2D Array, you can do sth like this in the end
Dim item AS Variant
Dim subCollection AS Collection
Dim nRows AS Integer
Dim nCols AS integer
' assuming "col" is your jagged collection
nRows = col.Count
For Each item in col
If TypeOf item is Collection
Set subCollection = item
If subCollection.Count > nCols Then
nCols = subCollection.Count
End If
Next item
Next item
Dim result(nRows, NCols) As Variant
' Now loop through the collections again and fill the result array
The problem that you have is that you cannot change the rank (dimensions) of an array with a redim statement.
dim sent() creates a 1-rank array, redim sent2(x, y) assumes a 2-rank array. Try dim sent(,).
Also, it will improve performance (and code robustness) if you use
dim sent1() as string
dim sent2(,) as string
In case anyone has this problem here is how I solved it:
<code>
Function find_sentences_complex(instring As String) As Variant
Dim xorr As String: xorr = ChrW(&H22BB)
Dim triple_bar As String: triple_bar = ChrW(&H2261)
Dim idisj As String: idisj = ChrW(&H2228)
Dim cond As String: cond = ChrW(&H2192)
Dim x As Integer, y As Integer, z As Integer, b As Integer
Dim total As Integer, paren_closure As Integer, marker As Boolean
Dim n As Integer
Dim sent1() As Variant, sent3() As Variant
'Dim final1d As Integer, final2d As Integer
Dim b_arr() As Integer
Dim b_max As Integer
Dim temp_string As String
For x = InStr(instring, "(") To Len(instring) Step 1
temp_string = Mid(instring, x, 1)
If Mid(instring, x, 1) = "(" Then
If marker = False Then
z = x
marker = True
End If
total = total + 1
ElseIf Mid(instring, x, 1) = ")" Then
total = total - 1
If total = 0 Then
marker = False
b = b + 1
paren_closure = x
ReDim Preserve sent1(b)
sent1(b) = Mid(instring, z, (x - z) + 1)
End If
End If
Next
Dim temp_sent1 As String
total = 0
marker = False
b = 0
Dim sent2()
ReDim sent2(UBound(sent1), 5)
For n = 1 To UBound(sent1)
temp_sent1 = sent1(n)
temp_sent1 = Mid(temp_sent1, 2, Len(temp_sent1) - 2)
b = 0
For x = 1 To Len(temp_sent1)
temp_string = Mid(instring, x, 1)
If Mid(temp_sent1, x, 1) = "(" Then
If marker = False Then
z = x
marker = True
End If
total = total + 1
ElseIf Mid(temp_sent1, x, 1) = ")" Then
total = total - 1
If total = 0 Then
marker = False
b = b + 1
paren_closure = x
'ReDim Preserve sent2(n, b)
sent2(n, b) = Mid(temp_sent1, z, (x - z) + 1)
End If
End If
Next
'this part of the code redimensions the side of the array
ReDim Preserve b_arr(n)
b_arr(n) = b
Next
b_max = MaxValOfIntArray(b_arr)
ReDim Preserve sent2(UBound(sent1), b_max)
End Function
Public Function MaxValOfIntArray(ByRef TheArray As Variant) As Integer
'This function gives max value of int array without sorting an array
Dim i As Integer
Dim MaxIntegersIndex As Integer
MaxIntegersIndex = 0
For i = 1 To UBound(TheArray)
If TheArray(i) > TheArray(MaxIntegersIndex) Then
MaxIntegersIndex = i
End If
Next
'index of max value is MaxValOfIntArray
MaxValOfIntArray = TheArray(MaxIntegersIndex)
End Function
</code>
Take a look at the following code. What my problem is is that I can't figure out how to redimension the n integer and the b integer. What I'm doing is the array sent1 is already working and it is populated with about 4 sentences. I need to go through each sentence and work on it but I'm having trouble.
dim sent1()
dim sent2()
dim n as integer, b as integer, x as integer
dim temp_sent as string
b = 0
For n = 1 to ubound(sent1)
temp_sent = sent1(n)
for x = 1 to len(temp_sent1)
code
if a then
b = b + 1
'**THIS IS THE PART OF THE CODE THAT IS NOT WORKING**
redim preserve sent2(1 to ubound(sent1), b)
sent2(n,b) = [code]
next
next
There are two issues in your code:
When you Dim an array without specifying the lower bound it will by default be 0 based (unless you have specified Option Base 1). When explicitly specified, lower bound can be any number, not just 0 or 1
For a multi dimensioned array, Redim Preserve can only change the last dimension, and then only the upper bound.
In general, I find it better to always specify Lower and Upper bounds, eg
Redim MyArray(1 to 10, 0 to 99)
Is there any specific reason why you want to / must use arrays?
If not, I'd suggest using collections instead. You can also have nested collections, e.g.
Dim dimension1 As New Collection
Dim dimension2 AS New Collection
dimension1.Add dimension2
etc.
That way, you won't have to worry about increasing dimensions manually at all. If you need to convert it back to a 2D Array, you can do sth like this in the end
Dim item AS Variant
Dim subCollection AS Collection
Dim nRows AS Integer
Dim nCols AS integer
' assuming "col" is your jagged collection
nRows = col.Count
For Each item in col
If TypeOf item is Collection
Set subCollection = item
If subCollection.Count > nCols Then
nCols = subCollection.Count
End If
Next item
Next item
Dim result(nRows, NCols) As Variant
' Now loop through the collections again and fill the result array
The problem that you have is that you cannot change the rank (dimensions) of an array with a redim statement.
dim sent() creates a 1-rank array, redim sent2(x, y) assumes a 2-rank array. Try dim sent(,).
Also, it will improve performance (and code robustness) if you use
dim sent1() as string
dim sent2(,) as string
In case anyone has this problem here is how I solved it:
<code>
Function find_sentences_complex(instring As String) As Variant
Dim xorr As String: xorr = ChrW(&H22BB)
Dim triple_bar As String: triple_bar = ChrW(&H2261)
Dim idisj As String: idisj = ChrW(&H2228)
Dim cond As String: cond = ChrW(&H2192)
Dim x As Integer, y As Integer, z As Integer, b As Integer
Dim total As Integer, paren_closure As Integer, marker As Boolean
Dim n As Integer
Dim sent1() As Variant, sent3() As Variant
'Dim final1d As Integer, final2d As Integer
Dim b_arr() As Integer
Dim b_max As Integer
Dim temp_string As String
For x = InStr(instring, "(") To Len(instring) Step 1
temp_string = Mid(instring, x, 1)
If Mid(instring, x, 1) = "(" Then
If marker = False Then
z = x
marker = True
End If
total = total + 1
ElseIf Mid(instring, x, 1) = ")" Then
total = total - 1
If total = 0 Then
marker = False
b = b + 1
paren_closure = x
ReDim Preserve sent1(b)
sent1(b) = Mid(instring, z, (x - z) + 1)
End If
End If
Next
Dim temp_sent1 As String
total = 0
marker = False
b = 0
Dim sent2()
ReDim sent2(UBound(sent1), 5)
For n = 1 To UBound(sent1)
temp_sent1 = sent1(n)
temp_sent1 = Mid(temp_sent1, 2, Len(temp_sent1) - 2)
b = 0
For x = 1 To Len(temp_sent1)
temp_string = Mid(instring, x, 1)
If Mid(temp_sent1, x, 1) = "(" Then
If marker = False Then
z = x
marker = True
End If
total = total + 1
ElseIf Mid(temp_sent1, x, 1) = ")" Then
total = total - 1
If total = 0 Then
marker = False
b = b + 1
paren_closure = x
'ReDim Preserve sent2(n, b)
sent2(n, b) = Mid(temp_sent1, z, (x - z) + 1)
End If
End If
Next
'this part of the code redimensions the side of the array
ReDim Preserve b_arr(n)
b_arr(n) = b
Next
b_max = MaxValOfIntArray(b_arr)
ReDim Preserve sent2(UBound(sent1), b_max)
End Function
Public Function MaxValOfIntArray(ByRef TheArray As Variant) As Integer
'This function gives max value of int array without sorting an array
Dim i As Integer
Dim MaxIntegersIndex As Integer
MaxIntegersIndex = 0
For i = 1 To UBound(TheArray)
If TheArray(i) > TheArray(MaxIntegersIndex) Then
MaxIntegersIndex = i
End If
Next
'index of max value is MaxValOfIntArray
MaxValOfIntArray = TheArray(MaxIntegersIndex)
End Function
</code>
I try to learn VBA. This code:
Dim i As Integer
Dim damage As String
i = 1
Do While 1
damage = CStr(Worksheets("charakters").Range("d14").Value)
you_min_damage = CInt(Left(damage, i))
If Right(i, 0) = "-" Then
Trim (you_min_damage)
Exit Do
End If
i = i + 1
Loop
cause this problem (in 4 iteration):
In cell D14 I have "4 - 11". I want to separate first number nad change it to integer.
You_min_damage is integer.
Try this one:
Dim you_min_damage As Integer, you_max_damage As Integer
Dim arr
'store all values in array
arr = Split(Worksheets("charakters").Range("d14").Value, "-")
'get first value
you_min_damage = CInt(arr(0))
'get last value
you_max_damage = CInt(arr(UBound(arr)))