I am having a sheet which contains range of values like "5670&&2","1281&&-3&-5&&7",... etc. in Column A.
Kindly help me to extract the output in VBA in following way:
For E.g 5670&&2 I require A1 cell contains 5670,B1 cell contains &&,C1 cell contains 2.
For E.g 1281&&-3&-5&&7,I would require that A1 cell contains 1281,B1 cell contains &&-,C1 cell contains 3,D1 cell contains &-,E1 cell contains 5,F1 cell contains && and G1 cell contains 7.
Pls help in the same .
Thanks.,
Here i have tried to write code to separate numbers from non-numbers. Numbers and non-numbers are copied to different columns, like Excel Text-To-Columns. Code is a little crazy, if u need i will provide comments. As input the ActiveSheet.UsedRange.Columns(1).Cells is used.
Option Explicit
Sub SeparateNumbers()
Dim targetRange As Range
Dim cellRange As Range
Dim charIndex As Integer
Dim oneChar As String
Dim nextChar As String
Dim start As Integer
Dim copiedCharsCount As Integer
Dim cellValue As String
Dim columnIndex As Integer
Set targetRange = ActiveSheet.UsedRange.Columns(1).Cells
For Each cellRange In targetRange
columnIndex = cellRange.Column
start = 1
copiedCharsCount = 0
cellValue = cellRange.Value
If (VBA.Strings.Len(cellValue) <= 1) Then GoTo nextCell
For charIndex = 2 To Len(cellValue)
oneChar = VBA.Strings.Mid(cellValue, charIndex - 1, 1)
nextChar = VBA.Strings.Mid(cellValue, charIndex, 1)
If VBA.IsNumeric(oneChar) And VBA.IsNumeric(nextChar) Then GoTo nextCharLabel
If Not VBA.IsNumeric(oneChar) And Not VBA.IsNumeric(nextChar) Then GoTo nextCharLabel
cellRange.Offset(0, columnIndex).Value = VBA.Strings.Mid(cellValue, start, charIndex - start)
columnIndex = columnIndex + 1
copiedCharsCount = copiedCharsCount + (charIndex - start)
start = charIndex
nextCharLabel:
If charIndex = Len(cellValue) Then
cellRange.Offset(0, columnIndex).Value = VBA.Strings.Right(cellValue, charIndex - copiedCharsCount)
End If
Next charIndex
nextCell:
Next cellRange
End Sub
Here is one more code. As a side product, function TextSplitToNumbersAndOther can be used independently as a formula to achieve the same effect.
To prevent accidental firing of the macro in a wrong sheet or a wrong column and overwriting neighbouring columns with scrap, named range "Start_point" should be defined by a user. Below this range in the same column, all data will be processed till the first blank row.
Spreadsheet example: http://www.bumpclub.ee/~jyri_r/Excel/Extracting_symbols_into_columns.xls
Option Explicit
Sub ExtractSymbolsIntoColumns()
Dim rng As Range
Dim row_processed As Integer
Dim string_to_split As String
Dim columns_needed As Long
Dim counter As Long
row_processed = 1
counter = 0
Set rng = Range("Start_point")
While rng.Offset(row_processed, 0).Value <> ""
string_to_split = rng.Offset(row_processed, 0).Value
columns_needed = TextSplitToNumbersAndOther(string_to_split)
For counter = 1 To columns_needed
rng.Offset(row_processed, counter).Value = _
TextSplitToNumbersAndOther(string_to_split, counter)
Next
row_processed = row_processed + 1
Wend
End Sub
Function TextSplitToNumbersAndOther(InputText As String, _
Optional SplitPieceNumber As Long) As Variant
Dim piece_from_split(100) As Variant
Dim char_from_input As String
Dim word_count As Long
Dim counter As Long
Dim char_type(100) As Variant
InputText = Trim(InputText)
If Not IsNull(InputText) Then
word_count = 1
piece_from_split(word_count) = ""
For counter = 1 To Len(InputText)
char_from_input = CharFromTextPosition(InputText, counter)
char_type(counter) = CharTypeAsNumber(char_from_input)
If counter = 1 Then
piece_from_split(word_count) = char_from_input
Else
If (char_type(counter - 1) = char_type(counter)) Then
piece_from_split(word_count) = piece_from_split(word_count) & char_from_input
'Merge for the same type
Else
word_count = word_count + 1
piece_from_split(word_count) = char_from_input
End If
End If
Next
End If
If SplitPieceNumber = 0 Then
TextSplitToNumbersAndOther = word_count
Else
If SplitPieceNumber > word_count Then
TextSplitToNumbersAndOther = ""
Else
TextSplitToNumbersAndOther = piece_from_split(SplitPieceNumber)
End If
End If
End Function
Function CharTypeAsNumber(InputChar As String, Optional PositionInString As Long) As Long
If PositionInString = 0 Then PositionInString = 1
If Not IsNull(InputChar) Then
InputChar = Mid(InputChar, PositionInString, 1)
Select Case InputChar
Case 0 To 9
CharTypeAsNumber = 1
Case "a" To "z"
CharTypeAsNumber = 2
Case "A" To "Z"
CharTypeAsNumber = 3
Case Else
CharTypeAsNumber = 4
End Select
Else
CharTypeAsNumber = 0
End If
End Function
Function CharFromTextPosition(InputString As String, TextPosition As Long) As String
CharFromTextPosition = Mid(InputString, TextPosition, 1)
End Function
You can write a UDF (user defined function) to achieve the objective.
Your two example are in an order (ascending) to filter out into adjacent columns in Excel (A, B, C, D...)
So is it correct to assume logically, that you will never have scenarios where you will have to break the string into non-adjacent columns? e.g. 1234 goes to A, && goes to C, 3 goes to D... resulting in A, C, D.
Asumption 2: That your splitted-string is not going to need columns more than Excel can provide.
Steps you may try:
1. Check your string is not empty
2. Split it by the characters other than numerics
3. At the start and end of each non-numeric character you may proceed to the next adjacent column.
search help: Split a string into multiple columns in Excel - VBA
Related
This is my first time using VBA and I'm having trouble finding a solution using FOR loops to count how many times a specific letter (entered by user) is in the string (entered by user).
Below I have what I have so I've found other solutions but they don't seem to utilize to FOR loop.
If anyone has any suggestions that'd be awesome.
Sub Week3()
Dim userInput As String
Dim letterSearched As String
Dim counter As Long
Dim occurances As Long
userInput = InputBox("type letters")
letterSearched = InputBox("type letter to be searched")
occurances = 0
For counter = 1 To Len(userInput)
If (InStr(counter, userInput, letterSearched)) > 0 Then
occurances = occurances + 1
Else
occurances = occurances
End If
Next
MsgBox (occurances)
End Sub
No need to use a loop. Is this what you are trying?
Option Explicit
Sub Sample()
Dim Mytext As String
Dim SearchText As String
Mytext = "Sample Text"
SearchText = "e"
MsgBox Len(Mytext) - Len(Replace(Mytext, SearchText, ""))
End Sub
EDIT
Yea I saw that solution but I'm supposed to implement a FOR loop – John Orsa 4 mins ago
Is this what you are trying?
Do not use InStr. Use Mid
For counter = 1 To Len(userInput)
If Mid(userInput, counter, 1) = letterSearched Then occurances = occurances + 1
Next
Note: If you want this not to be case sensitive then try this
For counter = 1 To Len(userInput)
If Mid(UCase(userInput), counter, 1) = UCase(letterSearched) Then occurances = occurances + 1
Next
I am trying to calculate the count of Unique values based on a condition.
For example,
For a value in column B, I am trying to count the Unique values in Column C through VBA.
I know how to do it using Excel formula -
=SUMPRODUCT((B2:B12<>"")*(A2:A12=32)/COUNTIF(B2:B12,B2:B12))
that value for 32 is dynamic - Programmatically I am calling them inside my vba code as Name
This is my code :
Application.WorksheetFunction.SumProduct((rng <> "") * (rng2 = Name) / CountIfs(rng, rng))
This is the sample data with the requirement
Alternatively, I Concatenated both the columns for keeping it simple and hoping to identify the Unique values which starts with name* method.
I don't know where I am going wrong. Kindly share your thoughts.
You may try something like this...
Function GetUniqueCount(Rng1 As Range, Lookup As String) As Long
Dim x, dict
Dim i As Long, cnt As Long
Set dict = CreateObject("Scripting.Dictionary")
x = Rng1.Value
For i = 1 To UBound(x, 1)
If x(i, 1) = Lookup Then
dict.Item(x(i, 1) & x(i, 2)) = ""
End If
Next i
GetUniqueCount = dict.Count
End Function
Then you can use it like below...
=GetUniqueCount($A$2:$B$10,C2)
Where A2:B10 is the data range and C2 is the name criteria.
I'd put the values into an array, create a temporary 2nd array and only add values to this array if they are not already present, and then replace the original array. Then it's just a simple matter to sum the unique values:
Sub Unique
dim arr(10) as variant, x as variant
dim arr2() as variant
for x = 1 to 10 ' or whatever
arr(x) = cells(x, 1) ' or whatever
next x
arr2 = UniqueValuesArray(arr)
' now write some code to count the unique values, you get the idea
End Sub
Function UniqueValuesArray(arr As Variant) As Variant()
Dim currentRow, arrpos As Long
Dim uniqueArray() As Variant
Dim x As Long
arrpos = 0
ReDim uniqueArray(arrpos)
For x = 0 To UBound(arr)
If UBound(Filter(uniqueArray, arr(x))) = -1 Then
ReDim Preserve uniqueArray(arrpos)
uniqueArray(arrpos) = arr(x)
arrpos = arrpos + 1
End If
Next x
UniqueValuesArray = uniqueArray
End Function
For example cell "A1" is linked to cell "B1", so in formula bar for cell "A1" we have:
=B1
How can I check whether value in cell "A1" contains letter B?
I tried the following:
Dim Criteria_3 As Boolean
Dim Value As Range
Set Value = Selection
Dim x As Variant
Set x = Cells
Dim text As String
For Each x In Value
If IsNumeric(x) Then
Criteria_3 = VBA.InStr(1, x.Formula, text) > 0
As soon as value of "Text" is "" it does not work and I really struggle to fined the right solution.
your question is not really conclusive, so here are two options:
To check wheter the value contains B:
blnCheck = 0 < InStr(1, rngCell.Value, "B")
To check wheter the Formula contains B:
blnCheck = 0 < InStr(1, rngCell.Formula, "B")
Regarding your null string problem:
As soon as value of "Text" is "" it does not work and I really struggle to fined the right solution.
That's because you're using VBA.InStr(1, x.Formula, text) and in this case 1 is an invalid index on a string of length 0. You can omit that, or you can code around it like:
If Len(Trim(x.Formula)) = 0 Then
'## Do nothing
Else
Criteria_3 = VBA.InStr(1, x.Formula, text) > 0
End If
To your specific question of identifying when a value contains any alpha character(s):
You can use a function like this to test whether a value contains any letter, by evaluating the Ascii code for each character, and break when True:
Function ContainsAnyLetter(val) As Boolean
Dim ret As Boolean
Dim str$, ch$
Dim i As Long
str = LCase(CStr(val))
For i = 1 To Len(str)
ch = Mid(str, i, 1)
If 97 <= Asc(ch) And Asc(ch) <= 122 Then
ret = True
Exit For
End If
Next
ContainsAnyLetter = ret
End Function
In your code, you could call it like:
Criteria_3 = ContainsAnyLetter(x.Value) '## or x.Formula, depending on your needs
You can use LIKE
https://msdn.microsoft.com/en-us/library/swf8kaxw.aspx
Something like if rngCell.value like "*B*" then
if your goal is to check whether the cell contains any valid range reference, then you could go like this
Option Explicit
Sub main()
Dim cell As Range
For Each cell In Worksheets("Sheet001").Range("A1:A20") '<== jus a test range, set it as per your needs
MsgBox IsCellReference(cell.Formula)
Next cell
End Sub
Function IsCellReference(text As String) As Boolean
On Error Resume Next
IsCellReference = Not Range(Replace(text, "=", "")) Is Nothing
End Function
My Excel looks like this
A B C D
1 2 3
I use this,
Dim row As DocumentFormat.OpenXml.Spreadsheet.Row = sheetData.Descendants(Of DocumentFormat.OpenXml.Spreadsheet.Row)().FirstOrDefault(Function(y) y.RowIndex.Value = 1)
I only get 3 Cells (B,C,D) in my result. How do i include the blank spaces?
Excel file contains only cells filled with their addresses. Empty cells are "virtual".
You can check by address cells, the "missing" cells are .
To translate the address (which is in "A1" style) to number index, you can use this function (credit: codeproject Article: Read and Write Microsoft Excel with Open XML SDK):
dim regexColName = New Regex("[A-Za-z]+", RegexOptions.Compiled)
Private Function ConvertCellReferenceToNumber(cellReference As String) As Integer
Dim colLetters = regexColName.Match(cellReference).Value.ToCharArray()
Array.Reverse(colLetters)
Dim convertedValue = Asc(colLetters(0)) - 65
For i = 1 To colLetters.Length - 1
Dim current = Asc(colLetters(i)) - 64
convertedValue += current * Math.Pow(26, i)
Next
Return convertedValue
End Function
with this function you can simulate empty cells:
Dim row As Row = SheetData.Descendants(Of Row)().FirstOrDefault(Function(y) y.RowIndex.Value = 2)
Dim cells = row.Descendants(Of Cell).ToDictionary(
Function(cell) ConvertCellReferenceToNumber(cell.CellReference),
function(cell) cell)
For i = 0 To cells.Keys.Max()
Dim c As Cell
If (cells.TryGetValue(i, c)) Then
Console.WriteLine(c.CellValue) 'need hanle for special values
Else
Console.WriteLine("empty")
End If
Next
I have Column A and what I'm looking to do is search for a phrase, say "test" and then if this phrase is found delete 2 rows after that.
I can see how to delete a row if the phrase is found in that row but not how to delete another row.
Try something like this:
Public Sub DeleteRowsIfFound()
Dim originCell As Range, numberOfRowsToDelete As Integer
Dim blankCellLimit As Integer, numberOfBlankCells As Integer
Dim label As String, index As Long, n As Integer
Set originCell = Me.Range("A1")
blankCellLimit = 5
numberOfRowsToDelete = 2
index = 0
label = "test"
Do
If originCell.Offset(index, 0).Value = label Then
For n = 0 To numberOfRowsToDelete - 1
originCell.Offset(index + 1, 0).EntireRow.Delete
Next
ElseIf originCell.Offset(index, 0).Value = "" Then
numberOfBlankCells = numberOfBlankCells + 1
End If
index = index + 1
Loop While numberOfBlankCells < blankCellLimit
End Sub
This starts searching down column A starting at cell A1, and if it finds a cell with the value "test" then it will delete the next two rows following it.