I am getting run time error 6: Overflow through the below code.
n = (.Cells(Rows.Count, "A").End(xlUp).Row)
FillP = Array("D", "E", "F", "H", "I", "J", "M", "O", "P", "AR", "AS", "BE", "BF", "BG", "BH", "BI", "BJ", "BK", "BL", "BQ", "BR", "BS", "BT", "BU", "BV", "BW", "BX", "BY", "CB", "CC", "CD")
'fill blanks with na
For i = 2 To n
For j = LBound(FillP) To UBound(FillP)
If Trim(.Range(FillP(j) & i)) = "" Then
.Range(FillP(j) & i) = "na"
End If
Next j
Next i
I have Excel 2010, I haven't yet declared any of the above variables yet (will do after testing). Just trying to fill blanks in specific columns with an "na". Nearly identical code appears earlier in my sub and yet it runs fine. No idea where i'm going wrong.
Thanks in advance for any help!
overflow results when you try to assign value to a variable, that exceeds the limitations of the data type.
I am afraid that you might have declared i, j, or n as Interger.
Also you will not need the dot operator before cells & range.
Where does the error specificaally occur? just from inspection, you do not need the dots before Cells and Range. You would only do that in a with statement
Related
How can I simplify this into one sentence in vba?
If [BT12] = "a" Then
Range("AB12").ClearContents
End If
If [BT13] = "a" Then
Range("AB13").ClearContents
End If
If [BT14] = "a" Then
Range("AB14").ClearContents
End If
Here it is in one line:
[AB12:AB14] = [IF(BT12:BT14 = "a","",AB12:AB14)]
Here is another using UNION:
Union(IIf([BT12] = "a", [AB12], [AFD1040000]), IIf([BT13] = "a", [AB13], [AFD1040000]), IIf([BT14] = "a", [AB14], [AFD1040000])).ClearContents
The first creates an array of the values, either "" or the value in the cell. It is very concise and can easily be expanded to include a larger range. The drawback is that if the data in AB is filled by formula the formula will be replaced by the value and the formula will be removed.
The second only clears those that need to be cleared leaving the others unchanged but is not as easily editable with larger ranges.
This is bad practice and not recommended but is a one-liner. It is expected that this would be wrapped in a With statement holding the parent sheet reference.
Dim i As Long: For i = 12 To 14: If .Cells(i, 72).Value = Chr$(97) Then .Cells(i, 28).ClearContents: Next
here's your one-sentence code:
If Not [BT12:BT14].Find("a", , xlValues, xlWhole) Is Nothing Then Range(IIf([BT12] = "a", IIf([BT13] = "a", IIf([BT14] = "a", "AB12:AB14", "AB12:AB13"), IIf([BT14] = "a", "AB12,AB14", "AB12")), IIf([BT13] = "a", IIf([BT14] = "a", "AB13:AB14", "AB13"), IIf([BT14] = "a", "AB14", "")))).ClearContents
that you can (possibly) read more comfortably as:
If Not [BT12:BT14].Find("a", , xlValues, xlWhole) Is Nothing Then Range( _
IIf([BT12] = "a", _
IIf([BT13] = "a", _
IIf([BT14] = "a", "AB12:AB14", "AB12:AB13"), _
IIf([BT14] = "a", "AB12,AB14", "AB12") _
), _
IIf([BT13] = "a", _
IIf([BT14] = "a", "AB13:AB14", "AB13"), _
IIf([BT14] = "a", "AB14", "") _
) _
) _
).ClearContents
Yes, it can be done :-)
Just for fun: assuming you provide an ► empty cell in [AB11], you can use this one liner via the Application.Index function:
[AB11:AB14] = Application.Transpose(Application.Index([AB11:AB14], Array(1, IIf([BT12] = "a", 1, 2), IIf([BT13] = "a", 1, 3), IIf([BT14] = "a", 1, 4)), 1))
(Edit thx DisplayName:)
Amplifying remarks to the Index function
You can find amplifying remarks to the use of the Index function at Insert first column in array without Loops or API calls
For what you are asking for; the IIF function works, whether you are evaluating using a True or False clause. Try this one liner.
For Each cel In Range("BT12:BT14"): IIf cel = "a", cel.Offset(, -44).ClearContents, True: Next
How can I simplify this into one sentence in vba?
Should you? Your example code is concise, and easy to read. As Rawrplus points out, shorter for the sake of being shorter is usually not a good idea.
One could simplify each line to this:
If [BT12] = "a" Then Range("AB12").ClearContents
If [BT13] = "a" Then Range("AB13").ClearContents
If [BT14] = "a" Then Range("AB14").ClearContents
Is that better? Arguably no in my opinion. If the actions of the condition ever need more complexity, you'll be forced to refactor anyway.
The quick answer is: it cant' be done. But one could figure out a solution if one want's to although it be rather far fetched.
First create a sub to put in a library module.
Sub ClearCellContent(ParamArray Args())
Dim i As Integer, J As Integer
i = UBound(Args)
For J = 0 To i Step 3
If Args(J).value = Args(J + 1) Then Args(J + 2).ClearContents
Next
End Sub
From a somewhere in your code you can now call this sub like so:
ClearCellContent [BT12], "a", [AB12], [BT13], "a", [AB13], [BT14], "a", [AB14]
Like I said, far fetched but a oneliner of sorts.
so I am making a decryption software that allows the user to input some text and then they can swap out letters in the program. For example, there is a drop down box that allows you to swap all the "O"'s in a user input to "W". So in the input "Stack overflow" the output would be "Stack wverflww".
However, my problem is is that when the user chooses a second letter to change, that has already been swapped, it causes a problem. For example, after the first above example has occurred, if the user then wanted to then change all the "W"'s in their input to "A"'s the output would be "stack averflaa". However, what I'm looking for the code to do is give an output of "Stack wverflwa". So only the original "W"'s of the user input are changed to the letter "A".
I hope the above makes sense.
Someone suggested using a two dimensional array to reassign the letters new letters and I am able to do this, but I have no idea how to then put this into my code and get it working. Below is my code and thank you to anyone who can help me.
Dim chooseLetter, replaceLetter, words2
chooseLetter = selectLetterCombo.Text
replaceLetter = replaceLetterCombo.Text
words2 = UCase(textInputBox.Text)
Dim replaceList As New List(Of String)
For Each z In words2
If z = chooseLetter Then
replaceList.Add(replaceLetter)
Else
replaceList.Add(z)
End If
Next
letterReplaceBox.Text = ""
For Each f In replaceList
letterReplaceBox.Text = letterReplaceBox.Text & f
Next
note: selectLetterCombo.Text is the letter chosen by the user that they want to replace and replaceLetterCombo.Text is the letter chosen by the user that they want to swap the first chosen letter with. Also, textInputBox.text is the text the user has inputted.
Thank you!
You should be able to keep a list of the index of the character that changed and check that before making another change.
'List to keep track of changed character index
Dim replacedCharsList As New List(Of Integer)'member variable
Dim chooseLetter, replaceLetter, words2
chooseLetter = selectLetterCombo.Text
replaceLetter = replaceLetterCombo.Text
words2 = UCase(textInputBox.Text)
Dim replaceList As New List(Of String)
Dim i As Integer
For i = 1 To Len(words2)
'remove the for each and go with a straight for loop to keep track if the index
If Mid(words2, i, 1) = chooseLetter Then
'check to see if we have already replaced this character via the index position
If replacedCharsList.Contains(i) = False Then
'we have not changed this so add the replacement letter and update our index list
replaceList.Add(replaceLetter)
replacedCharsList.Add(i)
Else
'we have already changed this character so just add it as is
replaceList.Add(Mid(words2, i, 1))
End If
Else
replaceList.Add(Mid(words2, i, 1))
End If
Next
letterReplaceBox.Text = ""
For Each f In replaceList
letterReplaceBox.Text = letterReplaceBox.Text & f
Next
I have an answer, but you're really not going to like it:
Option Infer On
Option Strict On
Imports System.Text.RegularExpressions
Module Module1
Dim swaps As New Dictionary(Of Char, Char)
Function DoSwaps(originalText As String, swapLetters As Dictionary(Of Char, Char)) As String
Dim newText As String = ""
For Each c In originalText
If swapLetters.ContainsKey(c) Then
newText &= swapLetters(c)
Else
newText &= c
End If
Next
Return newText
End Function
Sub Main()
Console.Write("Enter the text to be altered: ")
Dim t = Console.ReadLine()
Dim exitNow = False
Do
Console.Write("Enter the letter to swap from and the letter to swap to, or a blank line to quit: ")
Dim s = Console.ReadLine()
If s.Trim().Length = 0 Then
exitNow = True
Else
Dim parts = Regex.Matches(s, "([A-Za-z])")
If parts.Count >= 2 Then
Dim letter1 = CChar(parts.Item(0).Value)
Dim letter2 = CChar(parts.Item(1).Value)
If swaps.ContainsKey(letter1) Then
swaps.Item(letter1) = letter2
Else
swaps.Add(letter1, letter2)
End If
Console.WriteLine(DoSwaps(t, swaps))
End If
End If
Loop Until exitNow
End Sub
End Module
... unless you'd like to learn about the Dictionary class to understand how it works. I used a simple regular expression to parse the user input, but if you're using dropdowns to select the letters then that would just be bonus learning if you explore it.
The essential feature is that you keep the original string (t in the above code) and apply the transformation (I named it DoSwaps) to that each time, not to the previously transformed string.
These two functions will do the job, although there is no allowance for punctuation, just spaces.
Private Function EncryptText(str As String) As String
Dim swapletters() As String = {"l", "s", "d", "f", "g", "h", "j", "k", "a", "q", "w", "e", "r", "t", "y", "u", "i", "o", "p", "z", "x", "c", "v", "b", "n", "m"}
Dim encryptedText As String = ""
For Each letter As Char In str
If letter = " "c Then
encryptedText = encryptedText & " "
Else
Dim charactercode As Integer = Asc(letter) - 97
encryptedText = encryptedText & swapletters(charactercode)
End If
Next
Return encryptedText
End Function
Private Function DecryptText(str As String) As String
Dim swapletters As New List(Of String) From {"l", "s", "d", "f", "g", "h", "j", "k", "a", "q", "w", "e", "r", "t", "y", "u", "i", "o", "p", "z", "x", "c", "v", "b", "n", "m"}
Dim decryptedText As String = ""
For Each letter As Char In str
If letter = " "c Then
decryptedText = decryptedText & " "
Else
Dim character As String = Chr(swapletters.IndexOf(letter) + 97)
decryptedText = decryptedText & character
End If
Next
Return decryptedText
End Function
To use them, declare a string to hold the return value of each function
Dim etext As String
etext = EncryptText("disambiguation is the root of all evil")
results in etext being "faplrsajxlzayt ap zkg oyyz yh lee gcae"
and
Dim dtext As String
dtext = DecryptText("faplrsajxlzayt ap zkg oyyz yh lee gcae")
results in "disambiguation is the root of all evil"
My title might not be clear so I'll try to explain it with an example.
Let's say I have an excel sheet with one column for city names and another column for state names and a third column for country names. I want to loop through the columns and in a 4th column print what was found in the other 3 columns. So let's say column one is "Houston", column two is "Texas", and column three is "USA", how would I print to the fourth column "HTXUSA"? I have almost no experience in VB in Excel so I'm hoping someone will be able to help.
I searched for similar topics but couldn't find anything that was helpful. A couple threads helped a little bit, but I still don't have this figured out.
To get you started, here is a VBA solution. It uses a public Dictionary object. These really come from VBScript but can be used in VBA in a couple of ways, including by CreateObject. The dictionary is initialized just once, the first time the corresponding Abbreviate function is called. This function takes a range, and for each cell in the range sees if there is a corresponding dictionary key. If so -- the corresponding value is concatenated onto the growing string, if not -- the value itself is. I am making keys upper case so as to make everything case-insensitive:
Public Abbreviations As Variant
Public Initialized As Boolean
Sub Initialize()
Dim A As Variant, i As Long, n As Long
'modify the following:
A = Array("Houston", "H", "Dallas", "D", "Cleveland", "C", _
"Toronto", "T", "Texas", "TX", "Ohio", "OH", _
"Ontario", "ON", "Canada", "CAN")
n = UBound(A) - 1
Set Abbreviations = CreateObject("Scripting.Dictionary")
For i = 0 To n Step 2
Abbreviations.Add UCase(A(i)), A(i + 1)
Next i
Initialized = True
End Sub
Function Abbreviate(R As Range) As String
Dim i As Long, s As String
Dim cell As Range
If Not Initialized Then Initialize
For Each cell In R.Cells
If Abbreviations.exists(UCase(cell)) Then
s = s & Abbreviations(UCase(cell))
Else
s = s & UCase(cell)
End If
Next cell
Abbreviate = s
End Function
A screenshot of how it works:
I need to randomize character sets of 0-1, A-Z, -, and _. Lowercase cannot be part of it. Then xor encrypt it then eventually xor decrypt it. I don't have any issues with the xor encrypt logic as it will work fine with standard strconv(text,vbUnicode) - other than I get results that aren't the acceptable characters - but I am having trouble with how to use padding in my character set. Or alternately, I am going about this all wrong and should still use strconv and somehow restrict the results?
So to tackle this I am currently trying to make a custom conversion function that only uses the characters I mentioned. Since I only have 38 characters I know I need to use padding the get it to a factor of 2 but I am completely lost on how that would help. If I add in 26 equals signs as padding to get it to factor of 2 (38->64) I still am not sure what to do when it does a conversion and comes up with 38+ on the 0-63 scale of possibilities. Any help here would definitely be appreciated!
I did try just duplicating the string table for the last 26 characters but that obviously breaks on the decrypt since an A that originated because i was in position 38 would get translated back as having a value of 0.
So I basically have this:
Function Convert(sText As Variant, sDirection As String)
Dim aCharMap() As Variant
Dim aText() As Variant, bText() As String
Dim iText() As Byte, i As Integer, j As Integer, k As Integer
aCharMap = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "-", "_", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "-", "_")
If sDirection = "ToBinary" Then
ReDim aText(Len(sText) - 1)
ReDim iText(Len(sText) - 1)
For i = 1 To Len(sText)
aText(i - 1) = UCase(Mid$(sText, i, 1))
Next
For j = 0 To UBound(aText)
For k = 0 To UBound(aCharMap)
If aCharMap(k) = aText(j) Then
iText(j) = CByte(k)
Exit For
End If
Next k
Next j
Convert = iText()
ElseIf sDirection = "FromBinary" Then
bText = Split(sText, ",")
ReDim aText(LBound(bText) To UBound(bText))
For j = 0 To UBound(bText)
aText(j) = aCharMap(bText(j))
Next
Convert = Join(aText(), "")
End If
End Function
(And just to head off the inevitable question... No, this doesn't need to be secure. It isn't intended as a lock on a door. It is intended to very simply hide the door. I completely understand that if they look for it, it won't be hard to find and it will open right up with a gentle nudge.)
Thanks for any help!
A friend asked me to make a character string randomizer for a game she plays. I got the code working but now she wants to have the characters seperated every third character with a dash (or a space), but I can't get it to work. Any help will be appreciated.
For x As Integer = 1 To 10
strb.Append(chars(Int(Rnd() * UpperBound)))
If x Mod 2 = 0 Then
strb.Append("-")
The characters need to be separated, but how do I prevent the added dash at the end of the randomized characters?
Thanks guys (and girls) for your help it's working
Just append a dash (or whatever) every third character:
For x As Integer = 1 To 5
strb.Append(chars(Int(Rnd() * UpperBound)))
If x Mod 3 = 0 Then
strb.Append("-")
End If
Next
Since i haven't used those old VB function yet, i'll show you how to do it with VB.NET which could also be converted to C# easily:
Private Function RandomString(rnd As Random, size As Integer) As String
Dim chars() As String = {"a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"}
Dim builder As New System.Text.StringBuilder()
For i As Integer = 0 To size - 1
builder.Append(chars(rnd.Next(0, chars.Length)))
Next
Return builder.ToString()
End Function
Let us generate a random string with 5 chars:
Dim rnd = New Random()
Dim rndString = RandomString(rnd, 5)
Note that i'm passing the random instance since. If i would create it in the method and call it in a loop, it would generate the same strings since the Random would use the same time as seed.
Edit: I've only just seen that you need to separate the result. You could use an overloaded version:
Private Overloads Function RandomString(rnd As Random, size As Integer, separator As String, everyNChar As Int32) As String
Dim builder = New System.Text.StringBuilder()
Dim chars() As String = {"a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"}
For i As Integer = 0 To size - 1
If i > 0 AndAlso i Mod everyNChar = 0 Then
builder.Append(chars(rnd.Next(0, chars.Length))).Append(separator)
Else
builder.Append(chars(rnd.Next(0, chars.Length)))
End If
Next
Return builder.ToString()
End Function
Note that this will not count the separators.
You can use Regular Expressions to replace strings. It will be simple to change the regex and manage change requests :)
just replace TextBox1.Text = rndstring by :
TextBox1.Text = Regex.Replace(rndstring, "[a-zA-Z0-9]{3}", "$& ")
Note that you need to add Imports System.Text.RegularExpressions if not already done.
EDIT : I have given the above solution to insert a " " (whitespace) after every third character. If you want a hyphen (-) just change the second regex to "$&-"
If I'm understanding you correctly, change the if statement from If x Mod 2 = 0 Then to If x Mod 2 = 0 And x <> 10 Then. That way it wont append the dash if it is on the last element.