I am using below mentioned formula to filter out the unwanted text from a Cell. I would like to use this formula via VBA, i have tried some method that includes Sub Formula_Property and Recording Macro but not successful.
The formula is mentioned below:
=LEFT(A3,MIN(FIND({1,2,3,4,5,6,7,8,9,0},A3 & "1234567890"))-1)
The Main data is available in Sheet1 ColumnA2:A5000 and I would like the filtered text (Result) in Sheet3 column B2:B5000.
Is there anyway i can automate this using VBA, that would be helpful for me much.
Thank you
Parse Left of First Digit
Sub ParseLeftOfDigit()
Dim Data(): Data = Sheet1.Range("A2:A5000").Value
Dim r As Long, n As Long, rStr As String
For r = 1 To UBound(Data, 1)
rStr = CStr(Data(r, 1))
For n = 1 To Len(rStr)
If Mid(rStr, n, 1) Like "#" Then
Data(r, 1) = Mid(rStr, 1, n - 1)
Exit For
End If
Next n
Next r
Sheet3.Range("B2:B5000").Value = Data
End Sub
This macro will apply that formula to the range you wish.
Sub Filter_Text_Formula()
Sheets("Sheet3").Range("B2:B5000").FormulaR1C1 = "=LEFT(Sheet1!RC[-1],MIN(FIND({1,2,3,4,5,6,7,8,9,0},Sheet1!RC[-1] & ""1234567890""))-1)"
End Sub
Related
From cells E1:E25, I want to concat the word "hi" at the end of each word that exists in that range within my vba code. Here is what I have so far:
Workbooks("Test.xlsx").Worksheets("Sheet1").Range("E1:E25").Value = Workbooks("Test.xlsx").Worksheets("Sheet1").Range("E1:E25").Value + "hi"
It is giving me a "mismatch" error. Is there something I'm doing wrong?
I know there is a function to do this, I just want to know the VBA way.
Add Suffix
Copy both procedures to a standard module.
Adjust the values in the first procedure.
Only run the first procedure, the second is being called (by the
first).
The Code
Option Explicit
Sub addHi()
Dim rng As Range
Set rng = Workbooks("Test.xlsx").Worksheets("Sheet1").Range("E1:E25")
addSuffix rng, "Hi"
End Sub
Sub addSuffix(ByRef DataRange As Range, ByVal Suffix As String)
Dim Data As Variant, i As Long, j As Long
' Write values from range to array.
Data = DataRange.Value
' Loop through rows of array.
For i = 1 To UBound(Data)
' Loop through columns of array.
For j = 1 To UBound(Data, 2)
' Check if current value in array is not an error.
If Not IsError(Data(i, j)) Then
' Add suffix.
Data(i, j) = Data(i, j) & Suffix
' Write new current value to the Immediate window (CTRL+G).
'Debug.Print Data(i, j)
End If
Next j
Next i
' Write values from array to range.
DataRange.Value = Data
End Sub
#Tim Williams is correct. Loop over the cells in the range and update the values.
For Each Cell In Workbooks("Test.xlsx").Worksheets("Sheet1").Range("E1:E25")
Cell.Value = Cell.Value + "hi"
Next
I need to replace the value in a certain row that is repeated after a certain amount of rows. I have multiple Excels I need to do this.
Current data:
7th row: IN
16th row: IN ( comes after 9 rows)
25th row: IN ( comes after 9 rows)
I need these values to be replaced by OUT.
I did some research and seems like I could use macros but I am not familiar with macros.
Can anyone please help with macros with a loop or suggest any other ideas?
A simple excel formula can work per sheet, and of course a macro can work
The excel solution, starting in B2
=IF(AND($A1 = "IN",$A1 = $A2),"Out",$A2)
This formula will replicate your original column, with the fix. then a simple copy & paste as values of column B to A should work
A VBA solution, for which you need to select the relevant column:
Sub fixOut()
Dim cell As Object
For Each cell In Selection
If cell = "IN" AND cell = cell.OffSet(-1, 0) Then cell = "Out"
Next cell
End Sub
For Excel Office 365, create a macro going under View -> Macro -> View Macros -> You input a macro name and then press Create button.
A text editor screen should appear, the macro should be the following:
Sub test_macro()
Dim searching_string As String
searching_string = "IN"
replacing_string = "OUT"
searching_column = "A"
minimum_distance_to_be_modified = 3
previous_found_row = -1
row_number = 10000
For i = 1 To row_number
If Range(searching_column + CStr(i)).Value = searching_string Then
If i - previous_found_row <= minimum_distance_to_be_modified And previous_found_row <> -1 Then
Range(searching_column + CStr(i)).Value = replacing_string
End If
previous_found_row = i
End If
Next
End Sub
Set your searching_string, searching_column, minimum_distance_to_be_modified, replacing_string and you should be fine!
I did a test with the settings that you find in the snippet and this was the result:
Hope that this is going to help you.
I solved my problem via macros and VB code.
Sub Macro1()
'
' Macro1 Macro
'
Dim i As Integer
i = 7
Do While i <= Cells(Rows.Count, 1).End(xlUp).Row
Cells(i, 1).Value = "Out"
i = i + 9
Loop
End Sub
Add this code to new macros and run the macros if anyone is having a similar problem to mine.
You could try:
Option Explicit
Sub test()
Dim LastRow As Long, i As Long
Dim arr As Variant
'Change target worksheet if needed
With ThisWorkbook.Worksheets("Sheet1")
'Find the last row of column A
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'Set in arr the range with the data starting from row 1 to last row
arr = .Range("A1:A" & LastRow)
For i = LBound(arr) To UBound(arr) - 1
'Check if the current and the next Arr(i) are both "IN"
If arr(i, 1) = "IN" And arr(i + 1, 1) = "IN" Then
'Set the next arr(i) to OUT
arr(i + 1, 1) = "OUT"
End If
Next i
'Print the values
.Range("A1:A" & UBound(arr)).Value = arr
End With
End Sub
Assume to have the following Excel table
I'm trying to write a Macro in VBA which scans the cells in the routing column and spreads the substrings into the other columns. So this should be the final result
Potentially if the algorithm finds n substrings in the main string under the column Rtg it should fill n columns with the substrings.
Can you guys help me?
Thanks in advance
We can parse using the dash character:
Sub dural()
Dim i As Long, N As Long
N = Cells(Rows.Count, "B").End(xlUp).Row
For i = 2 To N
arr = Split(Cells(i, 2).Value, "-")
Cells(i, 2).Offset(0, 1).Resize(1, UBound(arr) + 1) = arr
Next i
End Sub
EDIT#1:
The code will err if it encounters an empty cell prematurely. To avoid this use:
Sub dural()
Dim i As Long, N As Long
N = Cells(Rows.Count, "B").End(xlUp).Row
For i = 2 To N
v = Cells(i, 2).Value
If v <> "" Then
arr = Split(v, "-")
Cells(i, 3).Resize(1, UBound(arr) + 1) = arr
End If
Next i
End Sub
As outlined here, you can use Text to Columns:
Select the cell or column that contains the text you want to split.
Select Data > Text to Columns.
In the Convert Text to Columns Wizard, select Delimited > Next.
Select the Delimiters for your data. You'd want to put a - in the "Other" area.
Select Next.
Select the Column data format or use what Excel chose for you.
Select the Destination, which is where you want the split data to
appear on your worksheet.
Select Finish.
Here is a simple sub for operating on the current active cell.
Sub splitCell()
Dim cellSplit As Variant
Dim nextColumn As Long
nextColumn = 1
cellSplit = Split(ActiveCell.Value2, "-")
For Each Item In cellSplit
ActiveCell.Offset(0, nextColumn).Value2 = Item
nextColumn = nextColumn + 1
Next
End Sub
None of the other solutions appear to deal with leading hyphens correctly.
This should deal with leading/trailing/double hyphens on the currently selected cells within one column. The caveat is that the individual substrings should not contain spaces.
Sub splitHyphens()
Dim i As Long, sel As Range, vals As Variant
For Each sel In Selection
vals = Split(Application.Trim(Replace(sel.Value, "-", Space(1))), Space(1))
sel.Offset(0, 1).Resize(1, UBound(vals) + 1) = vals
Next sel
End Sub
I have my data like so, in A1:A3 in excel.
stack',' over',' flow','
Is there anyway to combine this into one cell?
I've tried copy and paste to word and notepad ++ but they give me these with space gaps between them. My idea is to use these in a SQL query.
Other questions on here regard VBA for multiple rows.
Concatenante does not work as in reality I use a larger range then A1:A3
If you have CONCAT() function:
=CONCAT(A1:A3)
IF not:
= A1 & A2 & A3
If you do not have CONCAT, put this UDF in a module and use the formula as described above:
Function CONCAT(rng As Range)
Dim rngArr As Variant
Dim i As Long, j as long
rngArr = rng.Value
For i = LBound(rngArr, 1) To UBound(rngArr, 1)
For j = LBound(rngArr, 2) To UBound(rngArr, 2)
CONCAT = CONCAT & rngArr(i, j)
Next j
Next i
End Function
I am currently using a lot of For ... Each loops in my code which is slowing it down a lot, is there a faster approach?
I have heard I could copy the range to an array and edit the array and paste it back but im having a few problems with editing each cell in the array.
Here is the current for each code I am using - Thanks.
Dim cell As Range
For Each cell In Sheets("sheet1").UsedRange
cell.Value = cell.Value
Next cell
Try this - MUCH faster and more efficient:
Sheets("sheet1").UsedRange.Value = Sheets("sheet1").UsedRange.Value
Something along these lines:
Dim aCells As Variant
Dim x As Long
Dim y As Long
aCells = Sheets("Sheet1").UsedRange
' Now do something with the array;
' We'll debug.print the contents of each element
' to verify that it matches the cells in the sheet
For x = 1 To UBound(aCells, 1)
For y = 1 To UBound(aCells, 2)
Debug.Print aCells(x, y)
Next
Next