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 :)
After several hours of research, I still can't solve what seems to be a pretty simple issue. I'm new to VBA, so I will be as specific as possible in my question.
I'm working with a DDE link to get stock quotes. I have managed to work out most of the table, but I need a VBA to create a finished formula (i.e., without cell referencing) in order to the DDE link to work properly.
My first code is as follows:
Sub Create_Formulas()
Range("J1").Formula = "=Trade|Strike!" & Range("A1").Value
End Sub
Where J2 is the blank cell and A2 contains the stock ticker. It works fine, but when I try to fill out the rows 2 and bellow, it still uses A1 as a static value.
Sub Create_Formulas()
Dim test As Variant
ticker = Range("A1").Value
'Test to make variable change with each row
'Range("J1:J35").Formula = "=Trade|Strike!" & Range("A1:A35").Value
'not working
Range("J1:J35").Formula = "=Trade|Strike!" & ticker
'not working
End Sub
I couldn't find a way to solve that, and now I'm out of search queries to use, so I'm only opening a new topic after running out of ways to sort it by myself. Sorry if it is too simple.
You are referencing absolute cell adresses here. Like you would do when using $A$1 in a normal excel formula.
What you want to do is:
Dim row as Integer
For row = 1 to 35
Cells(row,10).Formula = "=Trade|Strike!" & Cells(row,1).Value
Next row
This will fill the range J1 to J35 with the formula. Since (row,10) indicates the intersection of row and column 10 (J)
Firstly, in your second set of code, you define a variable "test", but never give it a value.
You assign a value to the variable "ticker", and then never reference it.
Secondly, the value you have assigned to ticker is a static value, and will not change when it is entered in a different row.
Thirdly, I think your issue could be solved with a formula in Excel rather than VBA.
The "INDIRECT" function can be quite useful in situations like this.
Try inserting the formula
=INDIRECT("'Trade|Strike'!"&A1)
into cell A1, then copy down.
Note the ' ' marks around "Trade|Strike". This is Excels syntax for referencing other sheets.
The following is the result of downloading information from an accounting system. Basically, I was tasked with sorting through expenses from this year from an online system; once the information was downloaded from the online system, it was not formatted as a spreadsheet (so I couldn't easily use a simple lookup). The information was downloaded as a spreadsheet, however it didn't contain check numbers or names; excel formatted those away for some reason. The only thing that was left is the long stringy document, where each item in the PDF downloaded (which contained check numbers and names) was placed in column 1 (see picture 1), whereas it should have been placed in something formatted like picture 2. Obviously though PDF's do not maintain formatting.
So baring some way that I can transfer the PDF to a workbook and run an analysis (IE through copy paste or save as) I needed to get information from this long stringy thing (it's at 9000 rows at the moment, added in an excerpt).
First, this code sets the worksheet pers as a worksheet, gets the length of data in pers (example in picture 2), and length of data in expensesheet (example in picture 1)
Then it scans pers for items (prior to writing this code items were added manually - such as in the case of picture 2, 'supply 1' and corresponding information that can help denote supply 1, ie invoice #, description, date cut, and so on).
For each of those items, it then scans the "expense sheet". It tries to match the invoice number (which is the closest thing to a unique ID in this case) to the value in cell i, 1; if it exists, it then scans 'upwards' until it finds a long enough string so that it can be the 5 unit string; the one that contains a date, a check number, an amount, and a name, as well as a batch number and a memo.
Once it finds that string, it then splits it into an array, and then seeks to place it in the corresponding cells to the right of that row in worksheet pers.
Issues:
1) I keep receiving an error 400. Normally when I receive an error VBA shows what line. What is this? How can I set up an error catching block so that the editor will provide me more details on the error (ie place it occurred, reason for occurrence, etc)
2) I'm assuming that the long row (in this case its 12th from the top) can only be identified through its length. Is there a better way to identify the long row? Perhaps if it contains multiple dashes?
3) Does anyone know of a way to easily transfer a PDF of an accounting printout so that it retains its formatting when saved or copied to a spreadsheet?
4) Is there a way that this spreadsheet could be easily formatted through excel so that it can more adequately fit into the proper mold (more like picture 2)?
Option Explicit
Sub findDetailMemo()
Dim pers As Worksheet
Set pers = ThisWorkbook.Sheets("PERS")
Dim persLength As Long
persLength = pers.Range("a1").End(xlDown).Row
Dim expenseLength As Long
expenseLength = Range("a1").End(xlDown).Row
Dim currentDetail() As String
Dim i As Long
Dim j As Long
Dim k As Long
Dim tempInt As Long
'first scan all of the items in the pers unit
For k = 2 To 10
'next scan all of the expenses
For i = 2 To expenseLength
'if the invoice # is found
If InStr(Cells(i, 1), pers.Range("a1").Offset(k, 3)) <> 0 Then
'scan upwards; make sure you don't scan beyond the range of the spreadsheet
For j = i To 1 Step -1
'if the scan upwards finds a string that is 80 characters or more
If Len(Cells(i - j, 1)) >= 80 Then
'split it at the -
currentDetail = Split(Cells(i - j, 1), "-", -1, vbTextCompare)
'add it to the pers sheet
pers.Range("a1").Offset(k, 11) = currentDetail(0)
pers.Range("a1").Offset(k, 12) = currentDetail(1)
pers.Range("a1").Offset(k, 13) = currentDetail(2)
pers.Range("a1").Offset(k, 14) = currentDetail(3)
Exit For
End If
Next j
Exit For
Else
End If
Next i
Next k
End Sub
EDIT: After a discussion through the chat lobby, bdpolinsky and I found what was throwing the original error 400 (which was actually error 1004).
The first issue we fixed was the InStr() and Split() functions were referencing Cell objects instead of the string within them. This was fixed by simply adding Cells().Text where strings were required.
On the line If Len(Cells(i - j, 1).Text) >= 80, we discovered that Cells() wasn't referencing the correct worksheet. The fix for this was to define Cells() as pers.Cells(), which is the worksheet the information was imported to. Happy to report that the problem bdpolinsky was having has been solved (as far as the errors go).
The following is from the original answer:
1) At the start of your code (first executable line) you can press F8 to step through the code 1 line at a time until the error is flagged.
You can also use error handlers to catch an error and have excel do something different than default. Error Handling
Sub SomeCode()
Dim i As Integer
On Error GoTo ErrHandler
i = 1/0
ErrHandler:
MsgBox "Error Description: " & Err.Description
End Sub
You can also click next to a line of code to add a Break. Breaks look like red circles, and color that line of code red. Your code will stop when it reaches this line.
2)If Len(cellThatYoureChecking) > 20 Then Code
Or
If InStr(cellThatYoureChecking, "symbolYouWantToFind") <> 0 Then Code
Or visit this post about defining how many times a character is in a string with a function. You could then make your If statement based on the number of times it occurs.
3) This part is poor form for StackOverflow, but what you're asking is a little involved so see if this tutorial is of use to you. Import table from PDF to Excel.
4) The short answer to this is yes. There are a lot of ways to reorganize data in Excel. This question is a little too broad though, and it'd be more efficient to get questions 1-3 answered first before getting too ahead of ourselves.
I was trying to add conditional formats like this:
If expression =($G5<>"") then make set interior green, use this for $A$5:$H$25.
Tried this, worked fine, as expected, then tried to adapt this as VBA-Code with following code, which is working, but not as expected:
With ActiveSheet.UsedRange.Offset(1)
.FormatConditions.Delete
'set used row range to green interior color, if "Erledigt Datum" is not empty
With .FormatConditions.Add(Type:=xlExpression, _
Formula1:="=($" & cstrDefaultProgressColumn & _
.row & "<>"""")")
.Interior.ColorIndex = 4
End With
End With
The Problem is, .row is providing the right row while in debug, however my added conditional-formula seems to be one or more rows off - depending on my solution for setting the row. So I am ending up with a conditional formatting, which has an offset to the row, which should have been formatted.
In the dialog it is then =($G6<>"") or G3 or G100310 or something like this. But not my desired G5.
Setting the row has to be dynamicall, because this is used to setup conditional formats on different worksheets, which can have their data starting at different rows.
I was suspecting my With arrangement, but it did not fix this problem.
edit: To be more specific, this is NOT a UsedRange problem, having the same trouble with this:
Dim rngData As Range
Set rngData = ActiveSheet.Range("A:H") 'ActiveSheet.UsedRange.Offset(1)
rngData.FormatConditions.Delete
With rngData.FormatConditions.Add(Type:=xlExpression, _
Formula1:="=($" & cstrDefaultProgressColumn & _
1 & "<>"""")")
.Interior.ColorIndex = 4
End With
My Data looks like this:
1 -> empty cells
2 -> empty cells
3 -> empty cells
4 -> TitleCols -> A;B;C;...;H
5 -> Data to TitleCols
. .
. .
. .
25
When I execute this edited code on Excel 2007 and lookup the formula in the conditional dialog it is =($G1048571<>"") - it should be =($G1<>""), then everything works fine.
Whats even more strange - this is an edited version of a fine working code, which used to add conditional formats for each row. But then I realized, that it's possible to write an expression, which formats a whole row or parts of it - thought this would be adapted in a minute, and now this ^^
edit: Additional task informations
I use conditional formatting here, because this functions shall setup a table to react on user input. So, if properly setup and a user edits some cell in my conditionalized column of this tabel, the corresponding row will turn green for the used range of rows.
Now, because there might be rows before the main header-row and there might be a various number of data-columns, and also the targeted column may change, I do of course use some specific informations.
To keep them minimal, I do use NamedRanges to determine the correct offset and to determine the correct DefaultProgessColumn.
GetTitleRow is used to determine the header-row by NamedRange or header-contents.
With ActiveSheet.UsedRange.Offset(GetTitleRow(ActiveSheet.UsedRange) - _
ActiveSheet.UsedRange.Rows(1).row + 1)
Corrected my Formula1, because I found the construct before not well formed.
Formula1:="=(" & Cells(.row, _
Range(strMatchCol1).Column).Address(RowAbsolute:=False) & _
"<>"""")"
strMatchCol1 - is the name of a range.
Got it, lol. Set the ActiveCell before doing the grunt work...
ActiveSheet.Range("A1").Activate
Excel is pulling its automagic range adjusting which is throwing off the formula when the FromatCondition is added.
The reason that Conditional Formatting and Data Validation exhibit this strange behavior is because the formulas they use are outside the normal calculation chain. They have to be so that you can refer to the active cell in the formula. If you're in G1, you can't type =G1="" because you'll create a circular reference. But in CF or DV, you can type that formula. Those formulas are disassociated with the current cell unlike real formulas.
When you enter a CF formula, it's always relative to the active cell. If, in CF, you make a formula
=ISBLANK($G2)
and you're in A5, Excel converts it to
=ISBLANK(R[-3]C7)
and when that gets put into the CF, it ends up being relative to the cell it's applied to. So in row 2, the formula comes out to
=ISBLANK($G655536)
(for Excel 2003). It offsets -3 rows and that wraps to the bottom of the spreadsheet.
You can use Application.ConvertFormula to make the formula relative to some other cell. If I'm in row 5 and the start of my range is in row 2, I make the formula relative to row 8. That way the R[-3] will put the formula in A5 as $G5 (three rows up from A8).
Sub test()
Dim cstrDefaultProgressColumn As String
Dim sFormula As String
cstrDefaultProgressColumn = "$G"
With ActiveSheet.UsedRange.Offset(1)
.FormatConditions.Delete
'set used row range to green interior color, if "Erledigt Datum" is not empty
'Build formula
sFormula = "=ISBLANK(" & cstrDefaultProgressColumn & .Row & ")"
'convert to r1c1
sFormula = Application.ConvertFormula(sFormula, xlA1, xlR1C1)
'convert to a1 and make relative
sFormula = Application.ConvertFormula(sFormula, xlR1C1, xlA1, , ActiveCell.Offset(ActiveCell.Row - .Cells(1).Row))
With .FormatConditions.Add(Type:=xlExpression, _
Formula1:=sFormula)
.Interior.ColorIndex = 4
End With
End With
End Sub
I only offset .Cells(1) row-wise because the column is absolute in this example. If both row and column are relative in your CF formula, you need more offsetting. Also, this only works if the active cell is below the first cell in your range. To make it more general purpose, you would have to determine where the activecell is relative to the range and offset appropriately. If the offset put you above row 1, you would need to code it so that it referred to a cell nearer the bottom of the total number of rows for your version of Excel.
If you thought selecting was a bit of a kludge, I'm sure you'll agree that this is worse. Even though I abhor unnecessary Selecting and Activating, Conditional Formatting and Data Validation are two places where it's a necessary evil.
A brief example:
Sub Format_Range()
Dim oRange As Range
Dim iRange_Rows As Integer
Dim iCnt As Integer
'First, create a named range manually in Excel (eg. "FORMAT_RANGE")
'In your case that would be range "$A$5:$H$25".
'You only need to do this once,
'through VBA you can afterwards dynamically adapt size + location at any time.
'If you don't feel comfortable with that, you can create headers
'and look for the headers dynamically in the sheet to retrieve
'their position dynamically too.
'Setting this range makes it independent
'from which sheet in the workbook is active
'No unnecessary .Activate is needed and certainly no hard coded "A1" cell.
'(which makes it more potentially subject to bugs later on)
Set oRange = ThisWorkbook.Names("FORMAT_RANGE").RefersToRange
iRange_Rows = oRange.Rows.Count
For iCnt = 1 To iRange_Rows
If oRange(iCnt, 1) <> oRange(iCnt, 2) Then
oRange(iCnt, 2).Interior.ColorIndex = 4
End If
Next iCnt
End Sub
Regarding my comments given on the other reply:
If you have to do this for many rows, it is definitely faster to load the the entire range into memory (an array) and check the conditions within the array, after which you do the writing on those cells that need to be written (formatted).
I could agree that this technique is not "necessary" in this case - however it is good practise because it is flexible for many (any type of) customizations afterwards and easier to debug (using the immediate / locals / watches window).
I'm not a fan of Offset although I don't state it doesn't work as it should and in some limited scenarios I could say that the chance for problems "could" be small: I experienced that some business users tend to use it constantly (here offset +3, there offset -3, then again -2, etc...); although it is easy to write, I can tell you it is hell to revise. It is also very often subject to bugs when changes are made by end users.
I am very much "for" the use of headers (although I'm also a fan of reducing database capabilities for Excel, because for many it results in avoiding Access), because it will allow you very much flexibility. Even when I used columns 1 and 2; better is it to retrieve the column nr dynamically based on the location of the named range of the header. If then another column is inserted, no bugs will appear.
Last but not least, it may sound exaggerated, but the last time, I used a class module with properties and functions to perform all retrievals of potential data within each sheet dynamically, perform checks on all bugs I could think of and some additional functions to execute specific tasks.
So if you need many types of data from a specific sheet, you can instantiate that class and have all the data at your disposal, accessible through defined functions. I haven't noticed anyone doing it so far, but it gives you few trouble despite a little bit more work (you can use the same principles again over and over).
Now I don't think that this is what you need; but there may come a day that you need to make large tools for end users who don't know how it works but will complain a lot about things because of something they might have done themselves (even when it's not your "fault"); it's good to keep this in mind.
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.