I have values in cell like.
1,2,4,45,64,Jan. Ans: 5
I want to count only number from the cell.
Is it possible?
You could also use the split function in a UDF:
Function CountNumbers(R As Range) As Integer
Dim values, value As Variant
Dim result As Integer
values = Split(R.Text, ",")
result = 0
For Each value In values
If IsNumeric(value) Then
result = result + 1
End If
Next value
CountNumbers = result
End Function
From here, you could call it within another Excel cell as:
=CountNumbers(A1)
Here is my answer:
Sub countingNumbers()
Dim c As Range
Dim L As Long
Dim s As String
Dim tmp
Dim i
Dim y
Set c = Range("A1") 'Imagine in A1 is this: "RDFY2372784GDTD2GV3G3G3V3"
L = Len(c.Value) 'to store the len of the string
s = c.Value 'to store the string
y = 0 'the index of the numbers
For i = 1 To L
tmp = Left(Right(s, i), 1) 'to take just one letter at the time
If Asc(tmp) < 57 And Asc(tmp) > 48 Then
'if is a number ASC() returns the ASCII code of that number
'and increase y one by one || that is number by number
y = y + 1
End If
Next i
Range("B2").Value = y 'store the counting in B2
End Sub
Part of the ASCII Table:
+------------+-----------+
| ASCII Code | Character |
+------------+-----------+
| 48 | 0 |
| 49 | 1 |
| 50 | 2 |
| 51 | 3 |
| 52 | 4 |
| 53 | 5 |
| 54 | 6 |
| 55 | 7 |
| 56 | 8 |
| 57 | 9 |
| 64 | # |
| 65 | A |
| 66 | B |
| 67 | C |
| 68 | D |
| 69 | E |
| 70 | F |
| 71 | G |
| 72 | H |
| 73 | I |
| 74 | J |
+------------+-----------+
Here you can check the ASCII table
Related
My spreadsheet continuously refreshes data contained in the table based on a project number. There are 5 additional columns that contain manually inputted information (i.e. does not automatically refresh) associated with each project number. These columns essentially contain user comments and must stay associated with the project number through each refresh. When a refresh occurs, new project numbers may also be added to the list.
I am looking for a solution to store these 5 manually inputted columns with the project number.
Previously, we used a dictionary when only one key-value pairing was required. However, now we have multiple values for each key.
Public Function saveComments(rowOfCom As Integer, _
rowOfSafety As Integer, _
rowOfCompliance As Integer, _
rowOfCommercial As Integer, _
rowOfOperational As Integer, _
rowOfSIssue As Integer, _
ws As Worksheet) As Variant
'Sub is meant to save comments associated with masterplan id's
'We do this by first making one dictionary with every plan year and another
' dictionary that will store the mpids & comments
'Idea is to loop through each ws, store each mpid and comment then run macro
' to update mpids then paste in new comments
Dim mpDict As New Scripting.Dictionary
Dim numOfWS As Integer, count As Integer, rowCount As Integer, i As Integer
Dim rg As Range
Dim Key As Variant
Dim value As Variant
'Get the number of mpDictionaries needed. Counts the sheets if its a year
' or Not set just in case a sheet is added
With ws
rowCount = .Range("A1").End(xlDown).Row
For i = 2 To rowCount
If mpDict.Exists(.Cells(i, 1).value) = False Then
For j = 13 To j = 18
'Access the mpDict and store the MPID and Comment
mpDict.Add .Cells(i, 1).value, .Cells(i, j).value
Next j
End If
Next i
' Debug.Print (yearDict.Item(ws.Name).Item(.Cells(2, 1).value))
count = count + 1
End With
Set saveComments = mpDict
End Function
What I do in this case is to build a compound entry for each key. This can be in the form of a Class object, another Dictionary, a Collection or almost anything. For the simplest of situations though, I just create a CSV list.
For example, if my data is
+--------+----+
| red | 42 |
| green | 36 |
| blue | 49 |
| white | 44 |
| orange | 25 |
| black | 45 |
| purple | 32 |
| mauve | 41 |
| cherry | 14 |
| lemon | 32 |
| lime | 6 |
| red | 11 |
| green | 17 |
| blue | 13 |
| white | 9 |
| orange | 23 |
| black | 21 |
| purple | 38 |
| mauve | 19 |
| cherry | 22 |
| lemon | 42 |
| lime | 48 |
| red | 35 |
| green | 37 |
| blue | 44 |
| white | 6 |
| orange | 41 |
| black | 5 |
| purple | 15 |
| mauve | 20 |
+--------+----+
Then I'll build a using code similar to
Option Explicit
Sub BuildDictionaryExample()
Dim myDict As Dictionary
Set myDict = New Dictionary
Dim myData As Range
Set myData = Sheet1.Range("A1:B30")
Dim keyValue As Variant
Dim thisRow As Range
For Each thisRow In myData.Rows
keyValue = thisRow.Cells(1, 1)
If Not myDict.Exists(keyValue) Then
myDict.Add keyValue, thisRow.Cells(1, 2)
Else
Dim newValue As Variant
newValue = myDict(keyValue) & "," & thisRow.Cells(1, 2)
myDict(keyValue) = newValue
End If
Next thisRow
End Sub
I have about 1000 unique rows with columns to be split. I am new to VBA and not sure how to split multiple columns into rows with holding ID. The number of elements in a column can varies between rows but is the same across columns in the same row .
Input:
+----+---------------+----------+----------+
| id | col1 | col2 | col3 |
+----+---------------+----------+----------+
| 1 | abc, bcd, cde | aa,bb,cc | 1a,2b,3a |
| 2 | abc, ded | ba,de | a7,7a |
| 3 | a,b,c,d | d,c,d,a | f,d,s,a |
+----+---------------+----------+----------+
Output:
+----+------+------+------+
| id | col1 | col2 | col3 |
+----+------+------+------+
| 1 | abc | aa | 1a |
| 1 | bcd | bb | 2b |
| 1 | cde | cc | 3a |
| 2 | abc | ba | a7 |
| 2 | ded | de | 7a |
| 3 | a | d | f |
| 3 | b | c | d |
| 3 | c | d | s |
| 3 | d | a | a |
+----+------+------+------+
Your help will be greatly appreciated!
I don't know why "VBA: Split cell values into multiple rows and keep other data" this link as a previous answer but I think splitting one column and multiple columns are different questions.
Try this code (comments in code):
Sub Expand()
Dim currentRow As Long, lastRow As Long, table As Variant, i As Long, _
valuesInOneRowCol1 As Variant, valuesInOneRowCol2 As Variant, valuesInOneRowCol3 As Variant
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
currentRow = 2
'read hwole range to memory and clear the range to fill it with expanded data
table = Range("A2:D" & lastRow).Value2
Range("A2:D" & lastRow).Clear
For i = 1 To lastRow - 1
'split comma separated lists in each column
valuesInOneRowCol1 = Split(table(i, 2), ",")
valuesInOneRowCol2 = Split(table(i, 3), ",")
valuesInOneRowCol3 = Split(table(i, 4), ",")
'write all data from one row
For j = LBound(valuesInOneRowCol1) To UBound(valuesInOneRowCol1)
Cells(currentRow, 1) = table(i, 1)
Cells(currentRow, 2) = valuesInOneRowCol1(j)
Cells(currentRow, 3) = valuesInOneRowCol2(j)
Cells(currentRow, 4) = valuesInOneRowCol3(j)
currentRow = currentRow + 1
Next
Next
End Sub
I have a long excel file which contains numbers collected from a website. Less than 1% of the cells contain zero due to an error from the source. Therefore, I want to find update those cells and interpolate them with the nearest values. The length of the zero cells is some time single, hence I can simply take the average of the nearest non-zero values. However, a few places it is longer than one, hence I need to use linear interpolation.
Sample extracted data
+---+------+------+------+------+------+------+------+------+---+---+---+---+---+---+---+---+------+------+------+------+------+------+------+------+------+
| | 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 |
+---+------+------+------+------+------+------+------+------+---+---+---+---+---+---+---+---+------+------+------+------+------+------+------+------+------+
| 1 | 4058 | 4048 | 4049 | 4082 | 4090 | 4115 | 4118 | 4109 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 3990 | 4058 | 4064 | 4053 | 4057 | 4093 | 4123 | 4137 | 4133 |
+---+------+------+------+------+------+------+------+------+---+---+---+---+---+---+---+---+------+------+------+------+------+------+------+------+------+
Here's a very general script that might do something like that. It is only tested on positive values and ten rows, so you will definitely need to adapt it to many corner cases - but it should point you in the right direction:
Sub Interpolate()
Dim valueToTop As Integer
For Row = 1 To 10
valueToTop = -1
valueToBottom = -1
If Cells(Row, 1).Value = 0 Then
RowToTop = Row - 1
Do While RowToTop > 0
If Cells(RowToTop, 1).Value > 0 Then
valueToTop = Cells(RowToTop, 1)
Exit Do
End If
RowToTop = RowToTop - 1
Loop
Debug.Print valueToTop
Debug.Print RowToTop
RowToBottom = Row + 1
Do While RowToBottom > 0
If Cells(RowToBottom, 1).Value > 0 Then
valueToBottom = Cells(RowToBottom, 1)
Exit Do
End If
RowToBottom = RowToBottom + 1
Loop
Debug.Print valueToBottom
Debug.Print RowToBottom
Cells(Row, 2).Value = valueToTop + (Row - RowToTop) * (valueToBottom - valueToTop) / (RowToBottom - RowToTop)
End If
Next Row
End Sub
I have the following columns
12 A
11 M
12 B
12 C
11 A
9 M
13 N
11 M
12 C
11 B
15 M
I want to calculate median based on only Ms. I have done by selecting ranges.
I want to use columns rather than ranges. Is there any solution? Thanks for your help
If you have 2010 or later use this formula:
=AGGREGATE(17,6,(A:A/(B:B="M")),2)
If you have 2007 or earlier, try this array formula:
=MEDIAN(IF(B:B="M",A:A))
This is an array formula and must be confirmed with Ctrl-Shift-Enter.
Though the use of full column references will slow the calculation times because it will iterate through all the rows, all 1.04 million. It is good practice to limit the references to the max data range to help offset this drain. Change the C:C to something like $C$1:$C$10000 then it will loop only 10,000 times.
Well as a VBA user I love to use VBA, other can use your skill using formulas, and is completly right if you are good on formulas. Here is my answer and I hope help you.
Imagine you have this:
+----+------------+--------------------+---------------+
| 1 | Values (A) | Criteria Range (B) | Criteria ( C) |
+----+------------+--------------------+---------------+
| 2 | 14 | B | A |
| 3 | 1 | M | |
| 4 | 15 | A | |
| 5 | 15 | E | |
| 6 | 10 | A | |
| 7 | 3 | M | |
| 8 | 11 | A | |
| 9 | 8 | M | |
| 10 | 14 | A | |
| 11 | 5 | M | |
| 12 | 9 | M | |
| 13 | 10 | M | |
| 14 | 11 | N | |
| 15 | 9 | A | |
| 16 | 2 | M | |
| 17 | 15 | M | |
| 18 | 11 | A | |
| 19 | 12 | S | |
| 20 | 9 | M | |
| 21 | 11 | A | |
| 22 | 15 | V | |
+----+------------+--------------------+---------------+
And inside the cell E2 you have this =MedianIf($A$2:$A$22,$B$2:$B$22,C2) and the result must be 11
Because in a regular module of VBA you put this function.
Function MEDIANIF(RangeIf As Range, Criteria_Range1 As Range, Criteria1 As String) As Double
Dim i
Dim Counter
Dim tmp()
Dim subCouter
subCouter = 0
For Each i In Criteria_Range1
Counter = Counter + 1
If i.Value = Criteria1 Then
subCouter = subCouter + 1
ReDim Preserve tmp(1 To subCouter)
tmp(subCouter) = RangeIf(Counter)
End If
Next i
Dim a
MEDIANIF = Application.WorksheetFunction.Median(tmp())
End Function
And the function works like this:
RangeIF = is the range with the values that you want to get the MEDIAN
Criteria_Range1 = Is the range where you have all the criteria, is the same size as RangeIF
Criteria1 = Is the criteria you use to filter the data.
How about this low-tech solution:
In Column C, formulate: =IF(B2="M",A2,"") (in rows 2-12, based on your data, and assuming row 1 contains headers)
In cell D2 (or anywhere else), formulate: =MEDIAN(C:C)
Good day everybody!
I'm currently trying to figure something out in excel before implementing in it VBScript. I have to mathematically transpose a few cells (10*10 or 5r*10c) in a matrice:
-------------------------------
| .. | .. | .. | .. | .. | .. |
| 21 | 22 | 23 | 24 | 25 | .. |
| 11 | 12 | 13 | 14 | 15 | .. |
| 1 | 2 | 3 | 4 | 5 | .. |
-------------------------------
Must become
-------------------------------
| .. | .. | .. | .. | .. | .. |
| 3 | 13 | 23 | 33 | 43 | .. |
| 2 | 12 | 22 | 32 | 42 | .. |
| 1 | 11 | 21 | 31 | 41 | .. |
-------------------------------
Now I'm not a mathematician (I'm more ore less a programmer at the moment), but I came up with: F(y)=((MOD(x,10)-1)*10)+(1+((x-MOD(x,10))/10)) (x is the value in the pre-block a the top, y is the value in the pre-block below.) Now this works fine up to a certain point (e.g. 10).
In VBScript, I wrote the below at first:
Function GetPosInSrcRack(Pos)
Dim PlateDef(9), x, y, i, tmp
' Plate Definition
ReDim tmp(UBound(PlateDef))
For x = 0 To UBound(PlateDef)
PlateDef(x) = tmp
Next
i = 1
For x = 0 To UBound(PlateDef)
For y = 0 To UBound(PlateDef(x))
PlateDef(x)(y) = i
i = (i + 1)
Next
Next
'Dim msg ' Check definition
'For x = 0 To (UBound(PlateDef))
' msg = Join(PlateDef(x), ", ") & vbCrLf & msg
'Next
' Get the Position
y = (pos Mod 10)
x = ((pos - y) / 10)
GetPosInSrcRack = PlateDef(y)(x)
End Function
Which, of course, works but is crappy.
Using the above formula I would write:
Function GetPosInSrcRack(Pos)
Pos = (((Pos MOD 10)-1)*10)+(1+((Pos - (Pos MOD 10))/10))
End Function
But like I said, this still is incorrect (10 gives -8)
Can somebody help me?
Just use Paste Special > Transpose option.
y=(MOD(x-1,10))*10+INT((x-1)/10)+1
(By the way, what you are doing is not matrix transposition, but this does do what you do, only better.)