I have a bunch of cells that have two lines of text in each cell after pulling the data into Excel.
What I am looking to do is use a macro with the Trim function to remove everything in the cell after the second line.
I'm puzzled with this data, it's as if you were to enter data in a cell and Enter down to the next cell, but it's one cell and is not merged.
ex.
Someone's Name [123]
Procedure room, procedure done
Is there a way to identify this line break?
thanks so much for any assistance, my heads spinning and I'm punching out for the day.
cheers
Just look for the ASCII-10. Select the cells you wish to process and run:
Sub KleanUp()
Dim r As Range
For Each r In Selection
r.Value = Split(r.Value, Chr(10))(0)
Next r
End Sub
Only the first line will be retained in each cell.
EDIT#1:
As Ralph points out, ASCII-13 should also be considered, therefore:
Sub KleanUp2()
Dim r As Range
For Each r In Selection
r.Value = Split(Replace(r.Value, Chr(13), Chr(10)), Chr(10))(0)
Next r
End Sub
This converts to a single-style line-break.
EDIT#2:
It is possible to improve the performance of the sub by:
reading the data into a VBA array as a single large block
looping through the array (in VBA)
transferring the data back to the worksheet in a single block
Related
I wrote some code and have a question.
I sucessfully make macro which insert formular into cell.
Problem is It is not working automatically.
Function test(PCell As Range) As String
test = Chr(61) & Replace(PCell.Address, "$", "")
End Function
Cell shows =N3 (simple example). And I can execute Push "F2" - "Enter". It is working well.
Problem is .. There are more than 100 cells. If there is no solution, I have to push F2 - Enter 100 hundred times.
After select the cells, How can I execute the formular in cells? or by using VBA?
I tried to use Selection.Evaluate() But there is nothing happened. And "F9" key is also.
There is a faster and simpler way to achive this result.
'''vba
Sub ExecuteBulkFormula(SrcRng as Range,TgtRng as Range)
'What this procedure does is it loops through every area in the
'SrcRng and then loops through every cell in this area
'It then writes the formula in the array
'i: Loop Counter
'arr_index: Array Items Counter
'r_area: Every range contains atleast one Area as a Range Object
'The usage of Area is essential, as sometimes if we select multiple
'areas, For Example: A1:C2 & A5:C6, Then we can access these two "areas"
'The screenshot for the areas is added below (Figure 1).
'If however, we don't use Areas then we can only access the first Area
'i.e. A1:C2
Dim i as Long, arr_index as long
Dim r_area as Range
Dim arr as Variant
Redim arr(1 To 1000)
arr_index = 1
For Each r_area In SrcRng.Areas
For i = 1 to r_area.count
'Just Replace the below line to change the formula to fit your needs
arr(arr_index) = Chr(61) & Replace(r_area(i).Address, "$", "")
arr_index = arr_index+1
Next i
Next
Redim Preserve arr(1 To arr_index)
TgtRng.Formula = arr
End Sub
Figure 1
How to use this function?
In excel worksheet, press Alt+F11 or Developer Tab->Visual Basic
Right Click in any item in Project Explorer and then select Insert->Module
In this module, insert this above code.
To run this code you can use the immediate window (Ctrl+G) or write another procedure to run this code.
Suggestions
Instead of using Replace you can use Range.AddressLocal(False,False)
It will produce the same result.
This function ExecuteBulkFormula will run very fast
For 1000 rows: 0.016 sec (or 16 milliseconds)
For Reference my laptop is dual core i7-5500u which is low end.
to have function calculate at every sheet change, just add Application.Volatile (see:https://learn.microsoft.com/en-us/office/vba/api/excel.application.volatile)
Function test(PCell As Range) As String
Application.volatile
test = Chr(61) & Replace(PCell.Address, "$", "")
End Function
to place that cell in all cells of a given range:
Sub PlaceTest()
With Range("A1:A10") ' change the range address to to fit your needs
.Formula = "=test(RC[1])" ' this will feed the function with the cell 1 column to the right of where the function is placed: just play around with R1C1 notation (https://excelchamps.com/formulas/r1c1/)
End With
End Sub
I'm working on an record processing tool and have run into a problem.
One of our clients provides us with raw data that contains carriage breaks - making it unusable until formatted. Unfortunately the easy solution of running a clean function can't be used as it erases the last digit of the 16-digit account numbers in the process. Hoping that every end user remembers to keep destination formatting when porting the data over to have it formatted into text strings isn't really an option either.
So here's my plea for help:
I was able to get a clean value by using this formula
=IF(RIGHT(A2,1)=" ",LEFT(A2,LEN(A2)-1),A2)
I now need to turn it into a macro that will change the cell.value of the selected cells to the result of the formula. But after 8 hours of banging my head against the wall I just can't figure out how to do it. Any help is much appreciated!
Your formula in VBA:
Sub Klean()
Dim Cell As Range
For Each Cell In Selection
v = Cell.Value
If Right(v, 1) = " " Then
v = Left(v, Len(v) - 1)
Cell.Value = v
End If
Next Cell
End Sub
You need a function that iterates over a given set of cells. You can call that function using whatever cells are currently selected.
Option Explicit
Sub DoSomethingCool()
CleanCellText Selection
'--- or ---
CleanCellText ActiveSheet.Range("A1:Z20")
End Sub
Public Sub CleanCellText(ByRef thisRange As Range)
Dim cell As Range
For Each cell In thisRange
If Right$(cell.Value, 1) = " " Then
cell.Value = Left$(cell.Value, Len(cell.Value) - 1)
End If
Next cell
End Sub
Many thanks to everyone for such quick and informative responses!
I have managed to identify the issue - turns out as well as a carriage break the raw data also contained a tab space in front of the data that twas causing all the issues and was refusing to be edited by trim or manual edit! Here's the final code fr the macro button I embedded that solved the issue:
Private Sub CommandButton6_Click()
Dim Rng As Range
Set Rng = Selection
For Each cell In Rng
If IsEmpty(cell.Value) = False Then
cell.Value = Replace(cell.Value, Chr(9), "'")
End If
Next cell
End Sub
I've set the tab space to be replace by an apostrophe so that final value does not end up getting truncated, like what was happening when i used the clean function.
Once again many thanks everyone!
I code to fill down values. This is straight forward and can be done even without a script. (special - blanks - =value - ctrl entr)
I have another column where I need to copy the data upwards.
As seen in the image below, column A is filled downwards using the code;
Sub FillDown()
With Range("A:A")
.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
.Value = .Value
End With
End Sub
Operations Period is column A. Occurences are column Q. They are not all 1s. There are mixed values.
Column Q has the data which needs to be filled upward.
Adapted for going backwards. Not sure there is a cleverer way to do this. Over my head if there is.
Sub FillDown()
Dim r As Range
For Each r In Range("A:A").SpecialCells(xlCellTypeBlanks).Areas
r.Value = r.Offset(r.Rows.Count).Resize(1).Value
Next r
End Sub
Before
After
I have a long list of ids in excel. (a couple 100k rows) and every so often one of the ids will start with an equals. This causes excel to think it's a formula and gives me the #NAME? error. I know about adding a quote to the beginning of a forumla to make it text, but is there a faster way to do this since I have so many rows?
I also tried converting the cells to text and concatenating a ' at the beginning, but it still comes out as a #name? error.
Thank you!
=IFNA(FORMULATEXT(A1),A1) will do it, assuming A1 contains the datum.
FORMULATEXT(A1) will "undo" the conversion of =Something back to the original text, but returns #N/A if the cell doesn't contain a formula. The latter is circumvented with IFNA.
(Obviously you can copy and paste-special values once you've added what presumably is an extra column in your workbook to deal with this calculation.)
With data like:
running this small macro:
Sub FixEquals()
Dim r As Range, rng As Range, s As String
Set rng = Range("D:D").Cells.SpecialCells(xlCellTypeFormulas)
For Each r In rng
s = r.Formula
r.Clear
r.NumberFormat = "#"
r.Value = s
Next r
End Sub
will produce:
I have a slew of rows (100K+) to search and modify the contents.
For example the cells contain similiar text as DGC9610411:DB:10:82
All of this text can change per row except that fact that the : means something to me.
In this and every other row, i need to remove the first : and all the text after so that the cell would look like this DGC9610411
Next I will be adding the contents of another cell to the end. I think that will be an easy step and I could most likely figure that out without much effort.
I have this code in a while loop for each row. so the code is looking at one row at a time.
I have searched but everyone seems to have a different set of needs.
Just use Find and Replace, no need for vba or formulas.
Select the column containing the data that you need to modify
Press Ctrlh to open the Find and Replace dialog.
In the "Find what:" field, type :*
In the "Replace with:" field, leave it blank
Click Replace All
EDIT: If it has to be VBA, this simple macro will accomplish the same thing. Be sure to change the A to your actual column letter.
Sub tgr()
Columns("A").Replace ":*", ""
End Sub
EDIT: Upon request I am adding a formula solution. In cell B1 and copied down:
=LEFT(A1,FIND(":",A1&":")-1)
Try this small macro:
Sub colonoscopy()
Dim c As String
Dim r As Range, I As Long
For Each r In ActiveSheet.UsedRange
v = r.Value
I = InStr(1, v, ":")
If I > 0 Then
r.Value = Mid(v, 1, I - 1)
End If
Next r
End Sub