Hi guys i'm try learning VBA Excel , but i have some problem in my project
Here my code
For p = 10 To 36
If IsNumeric(Range("E" & p).Value) Then
E = Range("E" & p).Value
result2(p) = E * 1000
Range("E" & p).Value = result2(p)
End If
Next p
i'm try to make a statement when i insert some numeric the system automatic return value*1000
This is after the program running
it works only once.
It looks like your result2 variable is dim'ed as an integer. in wich case 1000 * 1000 is too large for an integer variable. An integer has to be between -32767 and 32767. So 1 milion can't be put into an integer.
If you change your result2 to a long array you should be okay.
I think, Problem is Worksheet_change is being called recursively because you are updating the value in same column.
You can handle this by using Application.EnableEvents. This will stop Worksheet_change event and after updating you can set it back to true.
Application.EnableEvents = False
set value in E column
Application.EnableEvents = True
Or You can simply use the following formula in a separate column (e.g. F) and paste it in entire column.
=IF(ISNUMBER(E2),E2*1000,0)
Instead of looping a range you could use Array which is faster:
Sub test()
Dim arr As Variant
With ThisWorkbook.Worksheets("Sheet1")
'Import all values to an array
arr = .Range("E10:E36")
'Loop array
For i = LBound(arr) To UBound(arr)
'Check if the value is numeric
If IsNumeric(arr(i, 1)) Then
'Multiple by 1000
arr(i, 1) = arr(i, 1) * 1000
End If
Next i
'Import array to the range
.Range("E10:E36") = arr
End With
End Sub
Related
123,123,123
456,789,456,258,652
I have 3 values in a single cell and have 5 values in the next cell delimited by a comma.
I want to compare all the values in the A1, if they all are unique the result should be True.
if not unique the result should be false.
Expected Output:
123,123,123
True
456,789,456,258,652
False
How to do this in excel. Kindly provide me an idea. Thanks in advance
Here is one simple implementation with VBA, however with formula also it could be possible
Sub CheckIfSame()
Dim counter As Integer
'Dim arrSplitStrings1() As Variant
counter = 2
Do While True
If Cells(counter, 1) <> "" Then
Cells(counter, 2) = ElementsSame(Split(Cells(counter, 1), ","))
Else
Exit Do
End If
counter = counter + 1
Loop
End Sub
Function ElementsSame(arr As Variant) As Boolean
Dim l As Long
ElementsSame = True
For l = 1 To UBound(arr)
If arr(0) <> arr(l) Then
ElementsSame = False
Exit For
End If
Next l
End Function
Solution based on VAR.S() function and Evaluate(). If all the numbers are equal then VAR.S()=0
Function IsEqual(txt As String)
IsEqual = Evaluate("VAR.S(" & txt & ")") = 0
End Function
I have a for loop, and inside it i have if statement.
In my Excel I have a list that contains each value one time. Once I found it i don't want the code to even check the conditional, i want it to skip this part of the if statement completely each time the loop is executed, is it possible?
Here is my code and list:
the first iteration of the loop will find that "c" is the value so it will do what inside it (xc = i)
I don't want the code to even check "ElseIf Cells(1, i) = "c" again, like the following image, is this possible?
code as text:
Sub test()
Dim i, xa, xb, xc As Integer
For i = 1 To 5
If Cells(i, 1) = "a" Then
xa = i
ElseIf Cells(i, 1) = "b" Then
xb = i
ElseIf Cells(i, 1) = "c" Then
xc = i
End If
Next i
End Sub
My initial interpretation of your need was "if the code hits 'c' again, just don't act".
To do so, you could modify the logic as follows:
ElseIf (xc = 0) And (Cells(i, 1) = "c") Then
This way, as soon as xc is set, the first boolean expression would be False, and the overall condition would not ever be met again. As mentioned by #TimWilliams, VBA would still evaluate the second boolean expression, unlike other languages that feature short-circuiting options. #Gene's answer describes a way around this. Typically, for better performance, you would evaluate the simple conditions first, before resorting to costly ones.
Additional notes
In VBA, you must give a type to each variable. In your Dim line, only xc is an Integer, while the other variables are Variants.
An unqualified Cells() call operates on the currently active worksheet, which might not be the expected one. Suggestion: qualify Cells() with the CodeName of your worksheet. The CodeName is what you see or specify under a worksheet's (Name) property as seen from the Visual Basic editor. For example, if (Name) is Sheet1, use Sheet1.Cells(). This will only work if the code resides in the same workbook as Sheet1. If the code is behind the worksheet itself, you can even use Me.Cells().
When dealing with cell values as your code does, VBA is (silently) being nice and understands that, among the numerous properties of the Range class, Value is what you are interested in. It is better practice, however, to explicitly state the target property, such as in Sheet1.Cells(i, j).Value.
EDIT
Knowing the values will be distinct and that there are about 60 of them, I suggest you simply use a Dictionary, as shown below, to get each value's row in one go, without a cascade of Ifs:
Option Explicit
Sub test()
Dim i As Integer
Dim dict As Object 'Scripting.Dictionary
Set dict = CreateObject("Scripting.Dictionary")
For i = 1 To 5
dict(Cells(i, 1).Value) = i
Next
Debug.Print dict("a") '4
Debug.Print dict("b") '2
Debug.Print dict("c") '1
'Etc.
End Sub
if i understood your question you can try this code:
Sub test()
Dim i, xa, xb, xc As Integer
Dim a, b, c As Boolean
a = False
b = False
c = False
For i = 1 To 5
If Cells(i, 1) = "a" And a <> True Then
xa = i
a = True
ElseIf Cells(i, 1) = "b" And b <> True Then
xb = i
b = True
ElseIf Cells(i, 1) = "c" And c <> True Then
xc = 1
c = True
End If
Next i
End Sub
Boolean variable is setted true for example only when the cells(i,1)="a" and after the next "a" value are skipped...
hope this helps
I just wanted to "mod" Ferdinando's code so it's a bit more "readable", I think. The main (the substantive) difference between this version and Ferdinando's or Excelosaurus' is that the cell is not even tested once the value is detected. Remember that the question was: I don't want the code to even check "ElseIf Cells(1, i) = "c" again... So, this version does exactly that.
Sub test()
Dim i As Integer, xa As Integer, xb As Integer, xc As Integer
Dim aFound As Boolean, bFound As Boolean, cFound As Boolean
Dim r As Range
For i = 1 To 5
Set r = Cells(i, 1)
If Not aFound Then
If r = "a" Then xa = i: aFound = True
ElseIf Not bFound Then
If r = "b" Then xb = i: bFound = True
ElseIf Not cFound Then
If r = "c" Then xc = i: cFound = True
End If
Next i
End Sub
I don't like the idea of 60 ElseIfs. Please examine the code below. In order to test it, create a worksheet called "TestSheet" and enter your A1:A5 to cells H2:H6.
Sub TestSpike()
' 06 Jan 2019
Dim Rng As Range
Dim Items As Variant
Dim Spike As String
Dim Tmp As String
Dim i As Integer
Dim R As Long
Items = Split("c|b|0|a|1", "|")
With Worksheets("TestSheet").Columns("H")
For R = 2 To 6
Tmp = CStr(.Cells(R).Value)
If InStr(1, Spike, Tmp, vbTextCompare) = 0 Then
Spike = Spike & "|" & Tmp
On Error Resume Next
i = Application.WorksheetFunction.Match(Tmp, Items, 0)
If Err Then
MsgBox Tmp & " wasn't found in Array"
Else
MsgBox "i = " & i & " = Item " & Tmp
End If
End If
Next R
End With
End Sub
The code has a "Spike". Each item is first checked against the Spike. If it is found there no further tests are carried out. Else, it is added to the Spike.
New items, after being added to the Spike, are checked against the Array "Items" which would hold your 60 elements, separated by Chr(124) thus, Split("c|b|0|a|1", "|"). I use the worksheet function MATCH to look for the item in the array. The result is an index number (or an error, if not found). You can use this index number in a Select Case statement to process each item distinct from others, basically the same way as you now process it when the If statement returns True.
One idea you may find useful with this kind of setup is to use the index from the Match function to return a value from another array. The other array might, for example, contain function names and you use Application.Run to call a different function for each item. This would run significantly faster than examining 60-odd Select Case statements.
I following program to call values to array and compare the values and give a result. I asked this question in another thread.
VPA program for compare values in array and give a result (MS Excel)
Here we can see that one dimensional array to which values are assigned. But i want to call values from multiple column when a IF condition is true
Dim arr as variable
For i = 1 to u
if mycondition1 then
x = Cells(i, 2).Value
m = Application.WorksheetFunction.CountIf(Range("B4:B" & u), x)
ReDim arr(1 To m)
For j = 1 to u
if mycondition2 then
arr(y) = Cells(j, 27)
End If
Next j
For one dimensional array i use code arr(y) = Cells(j, 27). Here i want to call values from column 27. Like this i want to assign values from different column (Say 27, 28, 29 upto 32). Instead of create six arrays, I know i can use two dimensional array say arr(1 to m, 1 to 6) and get values assigned from cells of each column and rows. But don't know how to compare values for each column similar to codes given below (which is comparison for one column values). I forced to write one comparison codes for each column. So my coding lines are more and take lots of time to execute. And i want do the for loop upto u=100.000 rows. Is there any easy way
w = arr()
Res = Application.Match(Array("No", "-"), w, 0)
For Each r In Res
ThisWorkbook.Worksheets("Sheet1").Cells(i, 27) = "X"
If Not IsError(r) Then
ThisWorkbook.Worksheets("Sheet1").Cells(i, 27) = "O"
Exit For
End If
Next r
Erase arr()
Exitsinglepart:
End If
Next i
End Sub
Please help me how to rewrite this code for comparing values called from each column.
Firstly, I must say that I don't understand what you want. Secondly, I feel that you are going about it the wrong way. In view of my first observation, I apologise. This is the way I would go about it:-
Private Sub TestIsYes()
Dim Arr As Variant
Arr = Array("Yes", "-", "Yes", "yes", "Yes")
Debug.Print IsYes(Join(Arr, ","))
End Sub
Function IsYes(StrArr As String) As String
' 25 Mar 2017
Dim Fun As Boolean
Fun = CBool(InStr(1, StrArr, "no", vbTextCompare))
If Not Fun Then
Fun = CBool(InStr(StrArr, "-"))
End If
IsYes = Split("No Yes")(CInt(Fun) + 1)
End Function
As you see, the function IsYes receives a string like "Yes,-,yes,Yes" and returns "Yes" or "No" based upon your criteria. You can test the function by changing the elements of the parameter array in the sub TestIsYes. TestIsYes could write this result directly into any cell on the worksheet.
This function might be modified in whatever way you need, but it remains at the core of your project. The question therefore is how to produce the string passed to IsYes as an argument. You wish (or should wish, perhaps) produce this string from a range. The next function does that.
Private Function RangeToString(Rng As Range) As String
' 25 Mar 2017
Dim Fun As String
Dim Arr As Variant
Dim R As Long, C As Long ' rows / columns
Arr = Rng.Value
With Arr
For R = LBound(Arr) To UBound(Arr)
For C = LBound(Arr, 2) To UBound(Arr, 2)
Fun = Fun & Arr(R, C) & ","
Next C
Next R
End With
RangeToString = Fun
End Function
Note that any array produced from an Excel range is 3-dimensional, even if it was taken from a single column. Therefore the above function produces a string of the kind required by IsYes from any range, regardless of how many columns it has.
I have set up a test in the worksheet range B2:C5 (4 rows, 2 columns - expand or reduce this as you wish), filled with your criteria. I created the following function using the functions explained before.
Function UDFIsYes(Rng As Range) As String
' 25 Mar 2017
UDFIsYes = IsYes(RangeToString(Rng))
End Function
You can call this function from the worksheet entering =UDFIsYes(B2:C5). You can call the same function from a VBA procedure like the following.
Private Sub TestUDF()
Debug.Print UDFIsYes(ActiveSheet.Range(Cells(2, 2), Cells(5, 3)))
End Sub
I hope this helps. Let me know where this information falls short of what you need.
I'm trying to generate words in Column B from a list of given words in Column A.
Right now my code in Excel VBA does this:
Function GetText()
Dim GivenWords
GivenWords = Sheets(1).Range(Sheets(1).[a1], Sheets(1).[a20])
GetText = A(Application.RandBetween(1, UBound(A)), 1)
End Function
This generates a word from the list I have provided in A1:A20, but I don't want any duplicates.
GetText() will be run 15 times in Column B from B1:B15.
How can I check for any duplicates in Column B, or more efficiently, remove the words temporarily from the list once it has been used?
For example,
Select Range A1:A20
Select one value randomly (e.g A5)
A5 is in Column B1
Select Range A1:A4 and A6:A20
Select one value randomly (e.g A7)
A7 is in Column B2
Repeat, etc.
This was trickier than I thought. The formula should be used as a vertical array eg. select the cells where you want the output, press f2 type =gettext(A1:A20) and press ctrl+shift+enter
This means that you can select where your input words are in the worksheet, and the output can be upto as long as that list of inputs, at which point you'll start getting #N/A errors.
Function GetText(GivenWords as range)
Dim item As Variant
Dim list As New Collection
Dim Aoutput() As Variant
Dim tempIndex As Integer
Dim x As Integer
ReDim Aoutput(GivenWords.Count - 1) As Variant
For Each item In GivenWords
list.Add (item.Value)
Next
For x = 0 To GivenWords.Count - 1
tempIndex = Int(Rnd() * list.Count + 1)
Aoutput(x) = list(tempIndex)
list.Remove tempIndex
Next
GetText = Application.WorksheetFunction.Transpose(Aoutput())
End Function
Here's how I would do it, using 2 extra columns, and no VBA code...
A B C D
List of words Rand Rank 15 Words
Apple =RAND() =RANK(B2,$B$2:$B$21) =INDEX($A$2:$A$21,MATCH(ROW()-1,$C$2:$C$21,0))
copy B2 and C2 down as far as the list, and drag D down for however many words you want.
Copy the word list somewhere, as every time you change something on the sheet (or recalculate), you will get a new list of words
Using VBA:
Sub GetWords()
Dim Words
Dim Used(20) As Boolean
Dim NumChosen As Integer
Dim RandWord As Integer
Words = [A1:A20]
NumChosen = 0
While NumChosen < 15
RandWord = Int(Rnd * 20) + 1
If Not Used(RandWord) Then
NumChosen = NumChosen + 1
Used(RandWord) = True
Cells(NumChosen, 2) = Words(RandWord, 1)
End If
Wend
End Sub
Here is the code. I am deleting the cell after using it. Please make a backup of your data before using this as it will delete the cell contents (it will not save automatically...but just in case). You need to run the 'main' sub to get the output.
Sub main()
Dim i As Integer
'as you have put 15 in your question, i am using 15 here. Change it as per your need.
For i = 15 To 1 Step -1
'putting the value of the function in column b (upwards)
Sheets(1).Cells(i, 2).Value = GetText(i)
Next
End Sub
Function GetText(noofrows As Integer)
'if noofrows is 1, the rand function wont work
If noofrows > 1 Then
Dim GivenWords
Dim rowused As Integer
GivenWords = Sheets(1).Range(Sheets(1).Range("A1"), Sheets(1).Range("A" & noofrows))
'getting the randbetween value to a variable bcause after taking the value, we can delete the cell.
rowused = (Application.RandBetween(1, UBound(GivenWords)))
GetText = Sheets(1).Range("A" & rowused)
Application.DisplayAlerts = False
'deleting the cell as we have used it and the function should not use it again
Sheets(1).Cells(rowused, 1).Delete (xlUp)
Application.DisplayAlerts = True
Else
'if noofrows is 1, there is only one value left. so we just use it.
GetText = Sheets(1).Range("A1").Value
Sheets(1).Cells(1, 1).Delete (xlUp)
End If
End Function
Hope this helps.
I have a column in Excel with the format:
A01G45B45D12
I need a way to format it like this, that is divide the string into groups of three characters, sort the groups alphabetically and then join them together with a + sign between:
A01+B45+D12+G45
I wonder it this is possible using the built in formulas in Excel or if I have to do this using VBA or something else, I already have the code for this in C# if there is an easy way to use that from Excel. I have not written plugins for Excel before.
Edit to add:
The above is just an example, the string can be of "any length" but its always divisible by three and the order is random so I cannot assume anything about the order beforehand.
Sub ArraySort()
Dim strStarter As String
Dim strFinish As String
Dim intHowMany As Integer
Dim intStartSlice As Integer
strStarter = ActiveCell.Offset(0, -1).Value 'Pulls value from cell to the left
intHowMany = Int(Len(strStarter) / 3)
ReDim arrSlices(1 To intHowMany) As String
intStartSlice = 1
For x = 1 To intHowMany
arrSlices(x) = Mid(strStarter, intStartSlice, 3)
intStartSlice = intStartSlice + 3
Next x
Call BubbleSort(arrSlices)
For x = 1 To intHowMany
strFinish = strFinish + arrSlices(x) & "+"
Next x
strFinish = Left(strFinish, Len(strFinish) - 1)
ActiveCell.Value = strFinish 'Puts result into activecell
End Sub
Sub BubbleSort(list() As String)
'Taken from power programming with VBA
'It’s a sorting procedure for 1-dimensional arrays named List
'The procedure takes each array element, if it is greater than the next element, the two elements swap positions.
'The evaluation is repeated for every pair of items (that is n-1 times)
Dim First As Integer, Last As Long
Dim i As Long, j As Long
Dim temp As String
First = LBound(list)
Last = UBound(list)
For i = First To Last - 1
For j = i + 1 To Last
If list(i) > list(j) Then
temp = list(j)
list(j) = list(i)
list(i) = temp
End If
Next j
Next i
End Sub