I want to extract 10 digit mobile form random string in cell A1 which has text as well as mobile numbers some has one mob ile other has two or maybe three mobile numbers .All mobile number to be saved in different coloumns.Only excel sheet formula is required
First of all, you will need to create a named range. The purpose of the named range is to normalize and split the data by space so that it can be read by other formulas without having to type that out each and every time.
First, put your data in column A starting in row 1 (as shown in your sample data image). Then create a named range with a name of SplitString and define it with this formula:
=INDEX(TRIM(MID(SUBSTITUTE(TRIM(SUBSTITUTE($A1,"."," "))," ",REPT(" ",999)),999*(ROW($1:$10)-1)+1,999)),)
Note the ROW($1:$10). The 10 in that is a guess that the strings will never have more than 10 entries to evaluate in a single cell. This is consistent with your sample data where the cell with the most entries is ROHTAK (BUILDER) 7777777777 PAL 6666666666 which has 5 entries to be evaluated. If you need to increase the number, just increase the 10 to be a higher number.
Then in cell B1 and copied over and down, use this formula which utilizes the SplitString named range that has been defined:
=IFERROR(IF(AND(ISNUMBER(--$A1),LEN($A1)=10,COLUMN(A1)=1),--$A1,--INDEX(SplitString,MATCH(1,INDEX((COUNTIF($A1:A1,SplitString)=0)*(LEN(SplitString)=10)*(ISNUMBER(--SplitString)),),0))),"")
I would try using regular expressions as mentioned in this answer : https://stackoverflow.com/a/22542835/2068595
On the face of it, I would look for this regex [0-9]{10} (meaning 10 consecutives characters from 0 to 9) in your column.
With data in column A run this short macro:
Sub numbersss()
Dim N As Long, L As Long, K As Long
Dim i As Long, j As Long, t As String
N = Cells(Rows.Count, "A").End(xlUp).Row
For j = 1 To N
t = Cells(j, 1).Text
L = Len(t)
For i = 1 To L
If Mid(t, i, 1) Like "[0-9]" Then
Else
Mid(t, i, 1) = " "
End If
Next i
ary = Split(Application.WorksheetFunction.Trim(t), " ")
K = 2
For Each a In ary
If Len(a) = 10 Then
Cells(j, K) = "'" & a
K = K + 1
End If
Next a
Next j
End Sub
For example:
If someone posts a pure formula solution, please ignore this post.
Related
I'm trying to solve a problem in VBA and after a long time of browsing the web for solutions, I really hope someone is able to help me.
It's actually not a very hard task, but with very little programming and VBA knowledge as a new learner, I hope I can find a useful tip or solution with the help of the community.
So my problem is as follows:
I have a table with 3 columns, the first is filled with a number to use as an ID. Column 2 and 3 have different values that needs to be compared:
What I'd like to do is select the range of column rows of column 2 and 3 based on the same ID. Once I have selected the relevant ranges of the columns, I want to compare if one name of column 2 matches one name of column 3.
So there is no need to have all names of the desired column ranges to match. One name match is enough. If a name matches, it should automatically fill in a new column "result" with 1 for match (0 for no match).
Do you have an idea, how I can select specific cells of a column based on an identifier?
Dim ID_counter As Long
ID_counter = 1
If Cell.Value = ID_counter IN Range("Column1")
Then Range("Column2").Select
AND Range("Column3").Select
WHERE ID_counter is the same
In Column4 (If one Cell.Value IN Range("Column2-X:Column2-Y")
IS IDENTICAL TO Range("Column3-X:Column3-Y"), return 1, else return 0
End Sub
Many thanks in advance for your help!
This works for your example so perhaps you can generalise it. The formula in D2 is
=IF(A2=A1,"",MAX(IF($A$2:$A$10=A2,COUNTIF($B$2:$B$10,$C$2:$C$10))))
and is an array formula so must be confirmed with CTRL, SHIFT and ENTER.
Array alternative via Match() function
This approach compares the string items of columns B and C by passing two arrays (named b,c) as arguments (c.f. section [1]):
chk = Application.Match(b, c, 0)
The resulting chk array reflects all findings of the first array's items via (1-based) position indices of corresponding items in the second array.
Non-findings return an Error 2042 value (c.f. section [2]b)); assumption is made that data are grouped by id.
Sub OneFindingPerId()
'[0]get data
Dim data: data = Sheet1.Range("A1:D10") ' << project's sheet Code(Name)
Dim b: b = Application.Index(data, 0, 2) ' 2nd column (B)
Dim c: c = Application.Index(data, 0, 3) ' 3rd column (C)
'[1]get position indices of identic strings via Match() function
Dim chk: chk = Application.Match(b, c, 0) ' found row nums of a items in b
'[2]loop found position indices (i.e. no error 2042)
Dim i As Long
For i = 2 To UBound(chk) ' omit header row
'a) define start index of new id and initialize result with 0
If data(i, 1) <> data(i - 1, 1) Then
Dim newId As Long: newId = i
data(newId, 4) = 0
End If
'b) check if found row index corresponds to same id
If Not IsError(chk(i, 1)) Then ' omit error 2042 values
If data(chk(i, 1), 1) = data(i, 1) Then ' same ids?
If data(newId, 4) = 0 Then data(newId, 4) = 1 ' ~> result One if first occurrence
End If
End If
Next i
'[3]write results
Sheet1.Range("A1").Resize(UBound(data), UBound(data, 2)) = data
End Sub
First enter this user defined function in a standard module:
Public Function zool(r1, r2, r3) As Integer
Dim i As Long, v1 As Long, v2 As String
Dim top As Long, bottom As Long
zool = 0
v1 = r1.Value
top = r1.Row
' determine limits to check
For i = top To 9999
If v1 <> r1.Offset(i - top, 0).Value Then
Exit For
End If
Next i
bottom = i - 1
For i = top To bottom
v2 = Cells(i, "B").Value
If v2 <> "" Then
For j = top To bottom
If v2 = Cells(j, "C").Value Then zool = 1
Next j
End If
Next i
End Function
Then in D2 enter:
=IF(OR(A2="",A2=A1),"",zool(A2,B2,C2))
and copy downwards:
(this assumes that the data has been sorted or organized by ID first)
In Excel, I have many products with different sizes listed in columns, such that the sizes "10x10 cm", "11x11 cm" and "15x15 cm" belongs to Product A, etc.
In some other cells, I am selecting a product (either Product A, Product B, or Product C) and a size.
I want, for each of the other products, to determine which size is closest to the selected product:
I don't know how to solve this. One solution might be to remove all non-numeric characters from the strings and add the two values on each side of the "x" and then select the size with the lowest absolute difference from the sum of the selected size.
But I guess it would be easier to do a mapping and use a VLOOKUP to choose the first found size in a given column.
However, the problem is that I do not only have 3 products with a few different sizes, but rather 15 different products with 10 different sizes, so I don't know how to do a mapping in a clever way.
1) Creating a lookup table with the values extracted for each product,
Source sheet:
Code:
Sub lookup()
Dim i As Long, j As Long, prod As Integer, str As String
prod = InputBox("Enter Number of Products")
Sheets.Add.Name = "LookupSheet"
j = 1
For i = 1 To prod
Columns(i).Copy Sheets("LookupSheet").Cells(1, j)
j = j + 2
Next i
For j = 1 To prod * 2 Step 2
For i = 2 To Sheets("LookupSheet").Cells(Rows.Count, j).End(xlUp).Row
str = Replace(Replace(Sheets("LookupSheet").Cells(i, j), " ", ""), "cm", "")
Sheets("LookupSheet").Cells(i, j + 1) = Left(str, InStr(str, "x") - 1) _
* Mid(str, InStr(str, "x") + 1, 999)
Next i
Next j
End Sub
This simple code creates a lookup sheet with the corresponding values. The code ignores any spaces present between the texts.
LookupSheet:
Since you have 15 different products, run this macro to extract the lookup data. This should be a one time activity unless you have additional products.
2) Assuming you enter the product and dimensions to F5 and F6, i would suggest you to data validation with dropdowns to select from the list,
3) Using a worksheet_change event, detect for changes in F5 and F6,
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim str As String, result As Integer, i As Long
'F5 and F6 contains Product and Size repectively
If (Target.Address = "$F$5" Or Target.Address = "$F$6") _
And Range("F5") <> "" And Range("F6") <> "" Then
str = Replace(Replace(Range("F6"), " ", ""), "cm", "")
result = Left(str, InStr(str, "x") - 1) * Mid(str, InStr(str, "x") + 1, 999)
j = 8
For i = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
If Cells(1, i) <> Range("F5") Then
Range("E" & j) = Cells(1, i)
j = j + 1
End If
Next i
End If
End Sub
This code automatically populated the rest of the product types in the column E,
4) The variable result would contain the product/area of the value that you provide in F6. The only task pending would be to loop through the lookup sheet to find the nearest match. The Algorithm is below,
Algorithm:
Compare cell F5 with the data in row 1 of lookup sheet (need to loop)
If they are equal, ignore and move to next value. If not, need to loop the immediate next column to find the next match, and populate the result in the corresponding cell in source sheet.
Algorithm for column wise looping is below,
Steps:
diff = cell.value - result
if diff < 0 then multiply diff by -1
loop:
nextdiff = nextcell.value - result (multiply by -1 if negative)
if nextdiff < diff then
diff = nextdiff
end if
end loop:
The cell value with the least difference would be your best match for that particular product type.
Bit lengthier explanation, hope this helps.
Please help,
I have excel with numbers in 2 columns for example:
10 10
20 2010, 2011
30 30100, 30200,30500
40 40
And the result I want to have is as follows:
1,2,3,4,5,6,7,8,9
10,11
100,200,500
1,2,3,4,5,6,7,8,9
So if the result between column 1 and 2 is 0 to have numbers from 1 to 9.
Is there a way to do this??
If you want to remove the characters in column one from any part of the values in column two, then try:
=IF(A1=B1,"1,2,3,4,5,6,7,8,9",SUBSTITUTE(SUBSTITUTE(B1," ",""),A1,""))
If you only want to remove the column one values from the beginning part of the column two values, then try:
=IF(B1=C1,"1,2,3,4,5,6,7,8,9",MID(SUBSTITUTE(SUBSTITUTE(","&C1," ",""),"," &B1,","),2,99))
Note that, for the final result, I removed the spaces as you showed in your example.
Using Second formula:
Here is a VBA approach:
Function AdHoc(x As Variant, y As Variant) As String
Dim v As Variant
Dim i As Long
Dim s As String
v = Split(y, ",")
If Val(x) = Val(v(0)) Then
s = "1,2,3,4,5,6,7,8,9"
Else
For i = 0 To UBound(v)
v(i) = Mid(Trim(v(i)), 1 + Len(Trim(Str(x))))
Next i
s = Join(v, ",")
End If
AdHoc = s
End Function
If this is entered into a standard code module, then AdHoc can be used directly in the worksheet:
In the above I simply entered =adhoc(A1,B1) in cell C1 and then copied down.
How do I extract only the first two letters and the 6 digit number from one cell to another? ie. Column 1 will have aa111111, bb222222, ccccc, dd12, eeee1
I only want to copy aa111111 and bb222222 in this case.
Thanks,
Alex
Try this short macro:
Sub KopyKat()
Dim N As Long, i As Long, K As Long
Dim s As String
N = Cells(Rows.Count, 1).End(xlUp).Row
K = 1
For i = 1 To N
s = Cells(i, 1).Value
If Len(s) = 8 _
And Mid(s, 1, 1) Like "[a-zA-Z]" _
And Mid(s, 2, 1) Like "[a-zA-Z]" _
And IsNumeric(Mid(s, 3)) Then
Cells(K, 2).Value = s
K = K + 1
End If
Next i
End Sub
If your strings are in A:A then in B1 (and copy down):
=IF(LEN(A1)>7,IF(AND(CODE(LOWER(MID(A1,{1,2},1)))<>CODE(UPPER(MID(A1,{1,2},1))),ISNUMBER(MID(A1,{3;4;5;6;7;8},1)*1)),LEFT(A1,8),""),"")
This is an array formula and must be confirmed with ctrl + shift + enter.
Running evaluate formula shows what happens and how it works :)
Using VBA then this will do:
Sub CopyMe()
Dim x As Variant, i As Long
For Each x In Range([A1], Cells(Rows.Count, 1).End(xlUp)).Value2
If x Like "[a-zA-Z][a-zA-Z]######" Then
i = i + 1
Cells(i, 2) = x
End If
Next
End Sub
Here is another way to do it. The formula loops through your string looking for a 6 digit number, at which point it takes the previous two characters (as long as they exist) and returns the 8 character string. Otherwise it returns an empty string.
=IFERROR(MID(A1,SUMPRODUCT(ROW($A$1:$A$100),--ISNUMBER(VALUE(MID(A1,ROW($A$1:$A$100),6))))-2,8),"")
Loops 100 times, so will work with strings up to a maximum length of 106 characters. To use the formula place your string in column A, and place this formula in cell B1 (for example) and drag down
In a program that I'm trying to write now I take two columns of numbers and perform calculations on them. I don't know where these two columns are located until the user tells me (they input the column value in a cell in the workbook that my code is located in).
For example, if the user inputted "A" and "B" as the columns where all the information is in I can perform calculations based on those values. Likewise if they wanted to analyze another worksheet (or workbook) and the columns are in "F" and "G" they could input those. The problem is that I'm asking the user to input those two columns as well as four others (the last four are the result columns). I did this in hopes that I would be able to make this flexible, but now inflexibility is acceptable.
My question is, if I'm given a value of where some information will be (let's say "F") how can I figure out what the column will be after or before that inputted value. So if I'm only given "F" I'll be able to create a variable to hold the "G" column.
Below are examples of how the variables worked before I needed to do this new problem:
Dim first_Column As String
Dim second_Column As String
Dim third_Column As String
first_Column = Range("B2").Text
second_Column = Range("B3").Text
third_Column = Range("B4").Text
Here the cells B2 - B4 are where the user inputs the values. Generally I want to be able to not have the B3 and B4 anymore. I feel like the Offset(0,1) might be able to help somehow but so far I've been unable to implement it correctly.
Thank you,
Jesse Smothermon
Here are two functions that will help you dealing with columns > "Z". They convert the textual form of a column to a column index (as a Long value) and vice versa:
Function ColTextToInt(ByVal col As String) As Long
Dim c1 As String, c2 As String
col = UCase(col) 'Make sure we are dealing with "A", not with "a"
If Len(col) = 1 Then 'if "A" to "Z" is given, there is just one letter to decode
ColTextToInt = Asc(col) - Asc("A") + 1
ElseIf Len(col) = 2 Then
c1 = Left(col, 1) ' two letter columns: split to left and right letter
c2 = Right(col, 1)
' calculate the column indexes from both letters
ColTextToInt = (Asc(c1) - Asc("A") + 1) * 26 + (Asc(c2) - Asc("A") + 1)
Else
ColTextToInt = 0
End If
End Function
Function ColIntToText(ByVal col As Long) As String
Dim i1 As Long, i2 As Long
i1 = (col - 1) \ 26 ' col - 1 =i1*26+i2 : this calculates i1 and i2 from col
i2 = (col - 1) Mod 26
ColIntToText = Chr(Asc("A") + i2) ' if i1 is 0, this is the column from "A" to "Z"
If i1 > 0 Then 'in this case, i1 represents the first letter of the two-letter columns
ColIntToText = Chr(Asc("A") + i1 - 1) & ColIntToText ' add the first letter to the result
End If
End Function
Now your problem can be solved easily, for example
newColumn = ColIntToText(ColTextToInt(oldColumn)+1)
EDITED accordingly to the remark of mwolfe02:
Of course, if you are not interested in the column names, but just want to get a range object of a specific cell in a given row right beneath a column given by the user, this code is "overkill". In this case, a simple
Dim r as Range
Dim row as long, oldColumn as String
' ... init row and oldColumn here ...
Set r = mysheet.Range(oldColumn & row).Offset(0,1)
' now use r to manipulate the cell right to the original cell
will do it.
You were on the right track with Offset. Here is a test function that shows a couple different approaches to take with it:
Sub test()
Dim first_Column As String
Dim second_Column As String
Dim third_Column As String
Dim r As Range
first_Column = Range("B2").Text
second_Column = Range("B2").Offset(1, 0).Text
third_Column = Range("B2").Offset(2, 0).Text
Debug.Print first_Column, second_Column, third_Column
Set r = Range("B2")
first_Column = r.Text
Set r = r.Offset(1, 0)
second_Column = r.Text
Set r = r.Offset(1, 0)
third_Column = r.Text
Debug.Print first_Column, second_Column, third_Column
End Sub
UPDATE: After re-reading your question I realize you were trying to do offsets based on a user-entered column letter. #rskar's answer will shift the column letter, but it will be a lot easier to work with the column number in code. For example:
Sub test()
Dim first_Col As Integer, second_Col As Integer
first_Col = Cells(, Range("B2").Text).Column
second_Col = first_Col + 1
Cells.Columns(first_Col).Font.Bold = True
Cells.Columns(second_Col).Font.Italic = True
End Sub
There are a few syntactical problems with #rskar's answer. However, it was helpful in producing a function that grabs a column "letter", based on an input column "letter" and a desired offset to the right:
Public Function GetNextCol(TheCol As String, OffsetRight As Integer) As String
Dim TempCol1 As String
Dim TempCol2 As String
TempCol1 = Range(TheCol & "1").Address
TempCol2 = Range(TempCol1).Offset(0, OffsetRight).Address(0, 0, xlA1)
GetNextCol = Left(TempCol2, Len(TempCol2) - 1)
End Function
In light of the comments of others (and they all raised valid points), here is a much better solution to the problem, using Offset and Address:
Dim first_Column As String
Dim second_Column As String
Dim p As Integer
first_Column = Range("B2").Text
second_Column = _
Range(first_Column + ":" + first_Column).Offset(0, 1).Address(0, 0, xlA1)
p = InStr(second_Column, ":")
second_Column = Left(second_Column, p - 1)
The above should work for any valid column name, "Z" and "AA" etc. included.
Make use of the Asc() and Chr() functions in VBA, like so:
Dim first_Column As String
Dim second_Column As String
first_Column = Range("B2").Text
second_Column = Chr(Asc(first_Column) + 1)
The Asc(s) function returns the ASCII code (in integer, usually between 0 and 255) of the first character of a string "s".
The Chr(c) function returns a string containing the character which corresponds to the given code "c".
Upper case letters (A thru Z) are ASCII codes 65 thru 90. Just google ASCII for more detail.
NOTE: The above code will be fine so long as the first_Column is between "A" and "Y"; for columns "AA" etc., it will take a little more work, but Asc() and Chr() will still be the ticket to coding for that.