I am using live data sheet in which I want to split each cell number into individual number and add them.
Example:
cell A1 contains number 265.96
Into 26596 and add these number
ie 2+6+5+9+6
You can do this with a formula like so in B1:
=SUMPRODUCT(1*MID(SUBSTITUTE(A1,".",""),ROW(INDIRECT("1:"&LEN(SUBSTITUTE(A1,".","")))),1))
Confirm with: CTLR+SHIFT+ENTER
An UDF might look like
Public Function GetSum(ByRef rng As Range) As Long
Dim i As Long
For i = 1 To Len(rng.Value)
If IsNumeric(Mid(rng.Value, i, 1)) Then GetSum = GetSum + Mid(rng.Value, i, 1)
Next i
End Function
Related
I have a list of numbers with duplicates in A1:A100. With the new dynamic array functions of Excel, we could write in Cell D1 =UNIQUE(A1:A100) to get a unique list.
Then, we could write in Cell E1 =D1#+100 to get a dynamic list based on the values of Column D.
Now, I would like to write a VBA function MYFUN to achieve the same thing, such that we could write =MYFUN(D1#) in Cell F1 to get the same values as Column E.
Dose anyone know how to write this?
It's not 100% clear what you want to do - there appears to be something missing.
However this will return what you have in column E when you enter the formula =MYFUN(D1#) in F1.
Function MYFUN(rng As Range) As Variant
MYFUN = Evaluate(rng.Address & "+100")
End Function
Here's an alternative that doesn't use Evaluate.
Function MYFUN(rng As Range) As Variant
Dim arr As Variant
Dim idx As Long
ReDim arr(1 To rng.Rows.Count, 1 To 1)
For idx = LBound(arr, 1) To UBound(arr, 1)
arr(idx, 1) = rng.Cells(idx, 1) + 100
Next idx
MYFUN = arr
End Function
I have a data of some binary numbers in few range of cells, from A2 to A8, B2 to B8, and so on, till G column.
Now, I want to check the largest binary number from the above Rows and paste it to the cell, two row below the last used range. (i.e., Largest binary number from Row A to be paste in A10, and so on).
I am not finding any function which can find the value of binary numbers, and the code which I ran finds out the max number considering those as natural numbers.
Your help will be appreciated.
Thank You!
Okay first i made a function that converts binary to decimal and stored in a module. (You can store it wherever you want) This function handles any size binary
Function BinToDecConverter(BinaryString As String) As Variant
Dim i As Integer
For i = 0 To Len(BinaryString) - 1
BinToDecConverter = CDec(BinToDecConverter) + Val(Mid(BinaryString, Len(BinaryString) - i, 1)) * 2 ^ i
Next
End Function
Afterwards i made the sub that loops through all binarys on sheet1 (Might need to change this for your sheet)
Sub FindLargestBinary()
On Error Resume Next
Dim wb As Workbook
Dim ws As Worksheet
Set wb = Application.ThisWorkbook
Set ws = wb.Sheets("Sheet1")
Dim tempVal, tempRow As Integer
Dim iCoulmn, iRow As Integer
For iCoulmn = 1 To 7 'Run from A to G
tempRow = 2
tempVal = 0
For iRow = 2 To 8 'Run from row 2 to 8
If BinToDecConverter(ws.Cells(iRow, iCoulmn).Value) > tempVal Then tempVal = BinToDecConverter(ws.Cells(iRow, iCoulmn).Value): tempRow = iRow ' Check if current binary i higher then any previous
Next iRow
ws.Cells(iRow + 1, iCoulmn).Value = ws.Cells(tempRow, iCoulmn).Value 'Print highest binary
Next iCoulmn
End Sub
Hope this helps you out..
You can use the excel function Bin2Dec to change them into decimal
Function MaxBin(r as range)
Dim curmax as long
Dim s as range
For each s in r
If Application.WorksheetFunction.Bin2Dec(s.Text) > curmax Then curmax = Application.WorksheetFunction.Bin2Dec(s.Text)
Next s
MaxBin = curmax
End Function
Assuming your binary values are text strings this formula converts the values to numbers, finds the MAX and then converts back to a text string
=TEXT(MAX(A2:A8+0),"00000")
confirmed with CTRL+SHIFT+ENTER
or you can use this version which finds the max using AGGREGATE function and doesn't require "array entry"
=DEC2BIN(AGGREGATE(14,6,BIN2DEC(A2:A8+0),1))
This code is just to calculate simple moving average. Opened an excel, created dummy array in C row from 1 to 20. I want to create a function for eg: SMA(C7,3) = which should give average of C5:C7.
Coming back to VBA after long time, not able to figure whats the error in the below code.
Function sma1(rng As Range, N As Integer)
Set rng = rng.Resize(-N + 1, 0)
sma1 = Application.WorksheetFunction.average(rng)
End Function
avoid using a cell name as a function
fixed the RESIZE()
used an internal range variable
Function smal(rng As Range, N As Integer) As Variant
Dim rng2 As Range
Set rng2 = rng.Resize(N, 1)
smal = Application.WorksheetFunction.Average(rng2)
End Function
EDIT#1:
Based on Scott's comment:
Function smal(rng As Range, N As Integer) As Variant
Dim rng2 As Range
Set rng2 = rng.Offset(1 - N, 0).Resize(N, 1)
smal = Application.WorksheetFunction.Average(rng2)
End Function
I assume you want the column along side it to give you're SMA (as shown below?):
If so, the below will do it and drag it autocomplete it to the bottom of you column C array:
Sub SMA3()
Range("D7").FormulaR1C1 = "=AVERAGE(R[-2]C[-1]:RC[-1])" 'This is a relative reference (left one cell and up two cells) - This give your three inputs
Range("D7").AutoFill Destination:=Range("D7:D" & Range("C1048576").End(xlUp).Row) 'Autofills the SMA
End Sub
Just an FYI this can be done with existing formula:
=IF(ROW(C1)<$E$1,"",AVERAGE(INDEX(C:C,ROW(C1)-$E$1+1):C1))
E1 contains the number of rows to include.
I have a problem when I downloaded a file containing different kind of information that should be stored in different cells but all is written in the same cell.
For example A:9 contains:
2016.03.16,"8982266507","QLGJG","AHGLG","OKK","IK","ODEADKIK","DK57200028982561607","485979,12","65164,94","485979,12","65164,94","485979,12","65164,94","","","","","","",
I would like to have a macro that copies specific parts of this string for example the last part "65164,94" and paste in to cell A:10.
Thank you in advance
As well as Seb's answer, you can use the split function. So:
Sub splitting_string()
Dim arr1 As Variant, var1 As String
var1 = Range("A9")
arr1 = Split(var1, ",")
For i = 0 To UBound(arr1)
Cells(10 + i, 1) = arr1(i)
Next i
End Sub
This will separate the long string in A9 into smaller ones by splitting them every time there's a comma, placing them in the cells below.
I'm working in VBA for excel. I have an array called "aKey" (1 by 137,000 strings but exact size is subject to change so making code generic is a neccesity). I need to paste aKey to the first column of a a worksheet. So far i have tried
Range(.Offset(1,0),.Offset(UBound(aKey)+1,0)).Value = aKey
but this seems to only paste 137,000 versions of the first entry of the array.
I have also tried
Range(.Offset(1,0),.Offset(UBound(aKey)+1,0)).Value = WorksheetFunction.Transpose(aKey)
which also didn't work. Through a google search I did find that the Transpose function has a limited pasting size which may very well be the problem there. Does anybody know of a method to avhieve my goal? Thanks
Sub Tester()
Dim a1(), a2(), i As Long, ub As Long
ReDim a1(1 To 1, 1 To 137000)
'load source array ("wrong" shape)
For i = 1 To 137000
a1(1, i) = i
Next i
ub = UBound(a1, 2)
ReDim a2(1 To ub, 1 To 1) 'resize a2 ("right" shape) to match a1
' "flip" the a1 array into a2
For i = 1 To ub
a2(i, 1) = a1(1, i)
Next i
'drop a2 to worksheet
ActiveSheet.Range("a1").Resize(ub, 1).Value = a2
End Sub
Here is an example of creating an array for a single column and placing it in a column:
Sub qwerty()
Dim aKey(1 To 137000, 1 To 1) As Variant
For i = 1 To 137000
aKey(i, 1) = Rnd
Next i
Range("A1:A137000") = aKey
End Sub