Related
I have a list of serial numbers with a prefix, and then a few numbers. All serial numbers are 8 characters, so depending on the prefix and amount of zeros, different amounts of leading zeros are added between the prefix and numbers. (ex. ALT00001, CAT00564, AAR19470, M0000003, MISC7859, MISC0025)
How can I remove all leading zeros from the Serial Numbers, but keep any zeros that are part of the actual number?
I would love to create a macro that does this, as I would have to run this code on multiple workbooks countless times a day.
With data in column A, in B1 enter:
=LEFT(A1,3) & --RIGHT(A1,5)
and copy downwards.
EDIT#1:
Based on the updated examples, we must find the position of the first numeral in the string and parse based on that.
In C1 enter:
=MIN(FIND({"0","1","2","3","4","5","6","7","8","9"},UPPER(A1)&"0123456789"))
and copy downwards. (this give the position of the first numeral)
Now in B1 enter:
=LEFT(A1,C1-1) & --RIGHT(A1,8-C1+1)
or:
=LEFT(A1,C1-1) & --RIGHT(A1,9-C1)
(if you don't want the "helper" column, combine the formulas)
EDIT#2:
Here is some code:
Sub Deb()
Dim Kolumn As String, rng As Range, cell As Range, s As String, L As Long
Dim i As Long
Kolumn = "A"
Set rng = Intersect(Columns(Kolumn).EntireColumn, ActiveSheet.UsedRange).Offset(1, 0).Cells
For Each cell In rng
s = cell.Value
If s = "" Then Exit Sub
L = Len(s)
For i = 1 To L
If IsNumeric(Mid(s, i, 1)) Then
GoTo Process
End If
Next i
MsgBox "bad data " & s
Exit Sub
Process:
cell.Value = Left(s, i + -1) & CLng(Mid(s, i))
Next cell
End Sub
EDIT#3:
Macros are very easy to install and use:
ALT-F11 brings up the VBE window
ALT-I
ALT-M opens a fresh module
paste the stuff in and close the VBE window
If you save the workbook, the macro will be saved with it.
If you are using a version of Excel later then 2003, you must save
the file as .xlsm rather than .xlsx
To remove the macro:
bring up the VBE window as above
clear the code out
close the VBE window
To use the macro from the Excel window:
Select the worksheet you want the macro to run on
ALT-F8
Select the macro
Touch RUN
To learn more about macros in general, see:
http://www.mvps.org/dmcritchie/excel/getstarted.htm
and
http://msdn.microsoft.com/en-us/library/ee814735(v=office.14).aspx
Macros must be enabled for this to work!
EDIT#4:
This code check for errors:
Sub Deb_2()
Dim Kolumn As String, rng As Range, cell As Range, s As String, L As Long
Dim i As Long
Kolumn = "A"
Set rng = Intersect(Columns(Kolumn).EntireColumn, ActiveSheet.UsedRange).Offset(1, 0).Cells
For Each cell In rng
s = cell.Value
If s = "" Then Exit Sub
L = Len(s)
For i = 1 To L
If IsNumeric(Mid(s, i, 1)) Then
GoTo Process
End If
Next i
MsgBox "bad data " & s
Exit Sub
Process:
If IsNumeric(Mid(s, i)) Then
cell.Value = Left(s, i + -1) & CLng(Mid(s, i))
End If
Next cell
End Sub
I have two approaches, one is using excel array formula to find the numerical value in the text string, and the other is using excel power query to transform the data in 4 simple steps.
Approach 1 - Array Formula
The following formula will firstly convert the text string to array, eg. ALT00001 will become {"A";"L";"T";"0";"0";"0";"0";"1"}, then examine each character in the array if it is a numerical value like this {FALSE;FALSE;FALSE;TRUE;TRUE;TRUE;TRUE;TRUE}, and lastly sum up all the TRUE results. This will give you the total number of numerical values in the text string.
{=SUM(--ISNUMBER(--MID(A1,ROW(INDIRECT("1:"&LEN(A1))),1)))}
Please note this is an array formula so you need to press CSE (Ctrl+Shift+Enter) upon finishing editing the formula.
In my workings, I entered the array formula in Cell B1, then in Cell C1 I entered the following formula to get the result.
=LEFT(A1,8-B1)&--RIGHT(A1,B1)
You can combine these two formulas but it will look awkwardly long and not so easy to interpret by others. If you do combine, you need to press CSE to make it work as it incorporates an array.
Approach 2 - Power Query
Although #Deb did not ask for a solution using Power Query (PQ), I still want to share an alternative way of solving the issue efficiently, given that the above formula-based solution is not so straight forward and somehow complicated.
PQ is able to transform data from multiple worksheets and have ample built-in functions that is quite user friendly. Please note you need to have Excel 2010 or later versions to be able to use PQ.
So here are the steps using PQ:
1) Load the data range to PQ Editor, one way of doing that is to highlight the data range and use From Table in the Data tab as shown below:
2) Once loaded, the PQ Editor will be opened in a new window. The next step is to separate the value into Text string and Numerical string. A quick way of doing that is to use the Split Column (By Non-digit to Digit) in the Transform tab of the PQ Editor as shown below.
3) Now we have the text in the first column and the number in the second column. Next step is to clear the "0" in front of the values in the number column. One way of doing that is to change the Data Type from Text to Whole Number, and then change it back to Text (I will explain why you need to change it back to Text in the next step).
4) Next step is to combine the two columns to get the desired result. One way of doing that is to add a custom column and use & to combine the values from the two columns as shown below.
=[Column1.1]&[Column1.2] the way of using & is same as in an excel formula
As mentioned in my last step, we need to change the number value back to text, the reason is that PQ Editor does not allow combining a text value with a numerical value, it will lead to the following error.
5) The last step will vary depends on your preference. What I did is to remove other columns and load the Result column to the current worksheet where your original data sits.
Unfortunately PQ could not over write source data. However in my opinion it is better to keep your source data somewhere safe without being overwritten, and export your edited/transformed data to a new place and work on it instead.
Here are the codes behind the scene but all steps are performed using the built-in functions which you can google the know-how of each of them easily.
let
Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
#"Split Column by Character Transition" = Table.SplitColumn(Source, "Column1", Splitter.SplitTextByCharacterTransition((c) => not List.Contains({"0".."9"}, c), {"0".."9"}), {"Column1.1", "Column1.2"}),
#"Changed Type1" = Table.TransformColumnTypes(#"Split Column by Character Transition",{{"Column1.2", Int64.Type}}),
#"Changed Type2" = Table.TransformColumnTypes(#"Changed Type1",{{"Column1.2", type text}}),
#"Added Custom" = Table.AddColumn(#"Changed Type2", "Result", each [Column1.1]&[Column1.2]),
#"Removed Other Columns" = Table.SelectColumns(#"Added Custom",{"Result"})
in
#"Removed Other Columns"
Cheers :)
I have a very large embedded IF formula that appears to occasionally break for no reason. Opening and closing the page a few times eventually gets it working again. I am wondering if there is a VBA alternative for it. Here is the IF formula I am running.
=IF(ISNUMBER(SEARCH("76210",E125)),"_012_00762_10",IF(ISNUMBER(SEARCH("76220",E125)),"_012_00762_20",IF(ISNUMBER(SEARCH("76900",E125)),"_012_00769_00",IF(ISNUMBER(SEARCH("76901",E125)),"_012_00769_01",IF(ISNUMBER(SEARCH("85702",E125)),"_012_00857_02",IF(ISNUMBER(SEARCH("85710",E125)),"_012_00857_10",IF(ISNUMBER(SEARCH("100800",E125)),"_012_01008_00",IF(ISNUMBER(SEARCH("100900",E125)),"_012_01009_00",IF(ISNUMBER(SEARCH("123100",E125)),"_012_01231_00",IF(ISNUMBER(SEARCH("124600",E125)),"_012_01246_00",IF(ISNUMBER(SEARCH("124601",E125)),"_012_01246_01",IF(ISNUMBER(SEARCH("124640",E125)),"_012_01246_40",IF(ISNUMBER(SEARCH("124641",E125)),"_012_01246_41",IF(ISNUMBER(SEARCH("142301",E125)),"_012_01423_01",IF(ISNUMBER(SEARCH("158801",E125)),"_012_01588_01",IF(ISNUMBER(SEARCH("158900",E125)),"_012_01589_00",IF(ISNUMBER(SEARCH("159203",E125)),"_012_01592_03",IF(ISNUMBER(SEARCH("159303",E125)),"_012_01593_03",IF(ISNUMBER(SEARCH("159401",E125)),"_012_01594_01",IF(ISNUMBER(SEARCH("159410",E125)),"_012_01594_10",IF(ISNUMBER(SEARCH("159420",E125)),"_012_01594_20",IF(ISNUMBER(SEARCH("159501",E125)),"_012_01595_01",IF(ISNUMBER(SEARCH("169000",E125)),"_012_01690_00",IF(ISNUMBER(SEARCH("186900",E125)),"_012_01869_00",IF(ISNUMBER(SEARCH("213200",E125)),"_012_02132_00",IF(ISNUMBER(SEARCH("213300",E125)),"_012_02133_00",IF(ISNUMBER(SEARCH("215400",E125)),"_012_02154_00",IF(ISNUMBER(SEARCH("220100",E125)),"_012_02201_00",IF(ISNUMBER(SEARCH("223800",E125)),"_012_02238_00",IF(ISNUMBER(SEARCH("225600",E125)),"_012_02256_00",IF(ISNUMBER(SEARCH("230700",E125)),"_012_02307_00",IF(ISNUMBER(SEARCH("230701",E125)),"_012_02307_01",IF(ISNUMBER(SEARCH("231800",E125)),"_012_02318_00",IF(ISNUMBER(SEARCH("235000",E125)),"_012_02350_00",IF(ISNUMBER(SEARCH("235020",E125)),"_012_02350_20",IF(ISNUMBER(SEARCH("242000",E125)),"_012_02420_00",IF(ISNUMBER(SEARCH("246400",E125)),"_012_02464_00",IF(ISNUMBER(SEARCH("292900",E125)),"_012_02929_00",""))))))))))))))))))))))))))))))))))))))
Basically it is built so a serial number is scanned and it populates a cell for the users who use this sheet with its results from the search. I am already running one macro in this sheet as well. Here is that...
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Intersect(Range("A2:A500, J2:J500"), Target) ' define range of interest
If Not rng Is Nothing Then ' check it's not "nothing"
If WorksheetFunction.CountA(rng) = rng.Count Then 'check for all of its cells being not empty
On Error GoTo safe_exit 'add error control
Application.EnableEvents = False 'don't do anything until you know something has to be done
rng.Offset(, 1).Value = Date 'write Date next to all relevant changed cells
End If
End If
safe_exit:
Application.EnableEvents = True
End Sub
Maybe there is a better way to build this search using a formula that isn't using embedded IF statements, but i couldn't think of another way to do it. Thanks in advance.
This may be what you're looking for:
=IF(ISNA(MATCH(1,IF(ISERR(SEARCH($A$5:$A$42,$E$125)),0,1),0)),"",INDEX($B$5:$B$42,MATCH(1,IF(ISERR(SEARCH($A$5:$A$42,$E$125)),0,1),0)))
entered as an array formula (CTRL-SHIFT-ENTER).
Here $A$5:$A$42 contains 76210, 76220, ... , 292900 (entered as text, not numbers); and $B$5:$B$42 contains _012_00762_10, _012_00762_20, ... , _012_02929_00.
Hope that helps.
Any time you have to go more than 2 deep on an IF you may want to rethink the usage.
What you can do is build a table from your values. Then reference that table as part of your lookup. Assuming your list of value is in range D8:E45 you could use the formula =VLOOKUP(E125,$D$8:$E$45,2).
The beginning of your table would look like what's seen below. The input result cell is referencing your input value and pulling the match of the second column.
To get your table you can take your source formula and replace (Find and Replace - Ctrl+H) some characters with unique delimiting characters. Then use Text To Columns Alt+D+E and delimit and Copy>Paste special>Transpose to quickly have it close to the format you need.
I have to columns with exported numbers, which are stored as text.
I tried to convert those data to numbers with this code.
Sub FormatColumns()
Columns(9).NumberFormat = "0"
Columns(10).NumberFormat = "0"
End Sub
It has done the job correctly (or it seems so), but I am still not able to work with those data as with numbers, but Excel tell me, that it is stored as number.
But when I verify it via formula =ISTEXT(), it always shows me TRUE
Could you help me with it, please? All tutorials and advices, which I've found on Google was via Formating cells or =VALUE(), but VALUE fucntion doesnt work for me, it shows me #VALUE.
Thank you in advance!
Another solution is:
Sub Macro1()
Range("A:A").Select 'Range of values you need converted
For Each Cell In Selection
Cell.Value = (Cell.Value * 1)
Next
End Sub
A non-vba equivalent solution is to have a "1" entered in a cell, copy that cell, select the range you would like converted to numbers, right click and press Paste Special -> Multiply.
This will leave all values in that range as numbers without changing the format. Tested with ISTEXT.
Make sure your settings also match with commas replacing decimals otherwise it may continue to have issues.
you must replace "," ~~> "."
Sub FormatColumns()
With Columns("i:j")
.Replace ",", "."
.NumberFormat = "#,###.00"
End With
End Sub
Check entire relevant region is set to Number format first.
Selection the relevant region and do a global replace of for nothing ("space" to "leave empty"). Then depending upon your locale try a global replace of , to ..
Next enter 1 in a spare cell, copy that cell, select the entire relevant region and Paste Special, Option, Multiply.
If that does not work switch . back to , and repeat the Paste Special.
Its the comma, needs to be . so 405,90 = 405.90
Converting numbers stored as text to numbers via Macro
Sub macro()
Range("F:F").Select 'specify the range which suits your purpose
With Selection
Selection.NumberFormat = "General"
.Value = .Value
End With
End Sub
Hilight the numbers you with to "fix" and run:
Sub fixNumbers()
With Selection
.NumberFormat = "General"
.Value = .Value
End With
End Sub
I need to dynamically generate word documents using text from an Access database table. The caveat here is that some of the text coming from the database will need to be modified into MergeFields. I am currently using Interop.Word (VBA Macro) and VB.NET to generate the document.
My steps so far look like this:
Pull standard .docx Template
Fill In template with pre-defined filler text from table
Add MergeFields by replacing pieces of the filler text with actual mergefields
Attach Datasource and execute Mail Merge
After testing, I noticed that I cannot simply store MergeFields into the access database as a string, they do not feed over into the actual document. What I am thinking then is creating a table of known strings that should be replaced with MergeFields by the coding.
For Example:
Step 2 will insert "After #INACTIVE_DATE# your account will no longer be active." which will be in the database text.
Step 3 will find/replace #INACTIVE_DATE# with a MergeField «INACTIVE_DATE». I am using Word Interop to do this, so theoretically I can loop through the document.
I wasnt able to do a "Find And Replace" from text to MergeField, so how should I go about implementing this?
Tagging VBA additionally as I am seeking a "VBA" style answer (Word Interop).
You've left out quite a lot of detail, so I'll go about answering this in somewhat general terms.
What you want to do is definitely achievable. Two possible solutions immediately come to mind:
Replacing ranges using Find
Inserting tokens using TypeText
Replacing ranges using Find
Assuming the text has already been inserted, you can search the document for the given pattern and replace it with a merge field. For instance:
Sub FindInsertMerge()
Dim rng As Range
Set rng = ActiveDocument.Range
With rng.Find
.Text = "(\#*\#)"
.MatchWildcards = True
.Execute
If .Found Then
ActiveDocument.MailMerge.Fields.Add rng, Mid(rng.Text, 2, Len(rng.Text) - 2)
End If
End With
End Sub
Will find the first occurence of text starting with #, matches any string and ends with #. The contents of the found range will then be replaced by a merge field. The code above can easily be extended to loop for all fields.
Inserting tokens using TypeText
While I would normally advice against using Selection to insert data, this solution makes things simple. Say you have a target range, rng, you tokenize the database text to be inserted, select the range, start typing and whenever a designated mail merge field is found, insert a field instead of the text.
For instance:
Private Sub InsertMergeText(rng As Range, txt As String)
Dim i As Integer
Dim t As String
Dim tokens() As String
tokens = Split(txt, " ")
rng.Select
For i = 0 To UBound(tokens)
t = tokens(i)
If Left(t, 1) = "#" And Right(t, 1) = "#" Then
'Insert field if it's a mail merge label.
ActiveDocument.MailMerge.Fields.Add Selection.Range, Mid(t, 2, Len(t) - 2)
Else
'Simply insert text.
Selection.TypeText t
End If
'Insert the whitespace we replaced earlier.
If i < UBound(tokens) Then Selection.TypeText " "
Next
End Sub
Call example:
InsertMergeText Selection.Range, "After #INACTIVE_DATE# your account will no longer be active which will be in the database text."
I was wondering how to avoid using Windows clipboard, when you want to "replicate" multiple sections of a Word document (using VBA in macros)
Why to avoid? Because we're using Word on a server, in a multiuser environment (I know that it is officially frowned upon)
Otherwise, this would be easily accomplished with Selection.Copy and Selection.Paste methods.
Thanks.
I finally resolved to copy word by word. FormattedText seemed to work fairly well, until the last word (some special (evidently) characters), where suddenly the cell that I just filled with copied content would go blank. When I increased the number of cells, other run-time errors would pop up, like Your table got corrupted, and other ambiguous ones. Somehow, the source cell that I was copying from always seemed to have these peculiar chars in the end with ASCII codes 13 and 7. I know what 13 means, but 7?
Anyway, I decided to copy everything apart from this last character with code 7. It seems to work alright. Both formatting and fields are copied too.
In any case, the whole story proved to me for one more time that programming in VBA is mostly trial-and-error occupation. You are never sure when something might break.. unless I am missing update on some crucial concepts..
Here's the chunks of the code I used. The idea is that first we have a document with a single 1x1 cell table, with some rich text content. In the first piece of the code (inside a macro) I multiply the cells:
Dim cur_width As Integer, i As Integer, max_cells As Integer, cur_row As Integer
Dim origin_width As Integer
If ActiveDocument.Tables.Count = 1 _
And ActiveDocument.Tables(1).Rows.Count = 1 _
And ActiveDocument.Tables(1).Columns.Count = 1 _
Then
max_cells = 7 ' how many times we are going to "clone" the original content
i = 2 ' current cell count - starting from 2 since the cell with the original content is cell number 1
cur_width = -1 ' current width
cur_row = 1 ' current row count
origin_width = ActiveDocument.Tables(1).Rows(1).Cells(1).Width
' loop for each row
While i <= max_cells
' adjust current width
If cur_row = 1 Then
cur_width = origin_width
Else
cur_width = 0
End If
' loop for each cell - as long as we have space, add cells horizontally
While i <= max_cells And cur_width + origin_width < ActiveDocument.PageSetup.PageWidth
Dim col As Integer
' \ returns floor() of the result
col = i \ ActiveDocument.Tables(1).Rows.Count
// 'add cell, if it is not already created (which happens when we add rows)
If ActiveDocument.Tables(1).Rows(cur_row).Cells.Count < col Then
ActiveDocument.Tables(1).Rows(cur_row).Cells.Add
End If
// 'adjust new cell width (probably unnecessary
With ActiveDocument.Tables(1).Rows(cur_row).Cells(col)
.Width = origin_width
End With
// 'keep track of the current width
cur_width = cur_width + origin_width
i = i + 1
Wend
' when we don't have any horizontal space left, add row
If i <= max_cells Then
ActiveDocument.Tables(1).Rows.Add
cur_row = cur_row + 1
End If
Wend
End If
In the second part of the macro I populate each empty cell with the contents of the first cell:
' duplicate the contents of the first cell to other cells
Dim r As Row
Dim c As Cell
Dim b As Boolean
Dim w As Range
Dim rn As Range
b = False
i = 1
For Each r In ActiveDocument.Tables(1).Rows
For Each c In r.Cells
If i <= max_cells Then
// ' don't copy first cell to itself
If b = True Then
' copy everything word by word
For Each w In ActiveDocument.Tables(1).Rows(1).Cells(1).Range.Words
' get the last bit of formatted text in the destination cell, as range
' do it first by getting the whole range of the cell, then collapsing it
' so that it is now the very end of the cell, and moving it one character
' before (because collapsing moves the range actually beyond the last character of the range)
Set rn = c.Range
rn.Collapse Direction:=wdCollapseEnd
rn.MoveEnd Unit:=wdCharacter, Count:=-1
' somehow the last word of the contents of the cell is always Chr(13) & Chr(7)
' and especially Chr(7) causes some very strange and murky problems
' I end up avoiding them by not copying the last character, and by setting as a rule
' that the contents of the first cell should always contain an empty line in the end
If c.Range.Words.Count <> ActiveDocument.Tables(1).Rows(1).Cells(1).Range.Words.Count Then
rn.FormattedText = w
Else
'MsgBox "The strange text is: " & w.Text
'the two byte values of this text (which obviously contains special characters with special
'meaning to Word can be found (and watched) with
'AscB(Mid(w.Text, 1, 1)) and AscB(Mid(w.Text, 2, 1))
w.MoveEnd Unit:=WdUnits.wdCharacter, Count:=-1
rn.FormattedText = w
End If
Next w
End If
b = True
End If
i = i + 1
Next c
Next r
Here are the images of the Word document in question. First image is before running the macro, second is between the first chunk of code and the last, while the third image is the resulting document.
Image 1
Image 2
Image 3
That's it.
In Office 2007+ VSTO, you can export the block with Range.ExportFragment and then go to your new document and import it with Range.ImportFragment. I haven't used this in production, but experimented with it and it seems to work OK.
One caveat, I got errors when trying to export as a .docx, but RTF seemed to work ok.
Both methods exist in VBA as well, but I only tested the VSTO methods.
This doesn't always work, with text fields, diagramms, for example, or if you need to copy it to another document, but it's good for copying simple formatted text inside one document.
'First select something, then do
Word.WordBasic.CopyText
'Then move somewhere
Word.WordBasic.OK;
To copy the whole document to a new document use this:
Word.Application.Documents.Add Word.ActiveDocument.FullName
I ran into a similar issue. I wanted to copy a table from one word doc to another using Powershell without using the clipboard. Since a user using the computer while the script ran could break the script by using the clipboard. The solution I came up with was:
Open the source document and put a bookmark covering the range of what I wanted (in my case a single table).
Save the source document with its bookmark in another location (to avoid changing the source document).
Opened the destination document and created a range object for where I wanted the table placed.
Used range.InsertFile with the first parameter of the source file with my bookmark and the second parameter of my bookmark name. This single operation pulled the entire table plus source formatting directly into the destination document.
I then added code based on where the insertion was being done and how much longer the story was to select the inserted table to allow further operations on it.
I tried many any other methods to move the table and this was by far the best. Sorry I can't provide VBA code for this solution.
Use the Text property of the Selection object to put the data into a string variable rather than onto the clipboard:
Dim strTemp as String
strTemp = Selection.Text
You can then insert the text stored in the variable elsewhere as needed.