Dim ST As String
ST = ActiveDocument.Paragraphs(1).Range.Text
In my document, Paragraphs(1) is actually 2 + 32. However, with Debug.Print ST, the output is 2 + 32. Is there any way to store the data without compromising the superscript and subscript formatting?
The objective behind this is to store 5 lines in ST(1 to 5) and then shuffle the order of the 5 lines.
1 - It is not clear how do you want to capture the paragraphs so I'm assuming that you will have those paragraphs selected, modify it based on your requirement
2 - It is also not clear on what shuffle means so I will assume that you want it to be reversed, you will need to come out with your own logic on how to shuffle the paragraphs:
FormattedText property can be used to replace a range with formatted text so this should work for you:
Private Sub ShuffleSelectedParagraphs()
ActiveDocument.Content.InsertParagraphAfter
Dim i As Long
For i = Selection.Paragraphs.Count To 1 Step -1
ActiveDocument.Content.Paragraphs.Last.Range.FormattedText = Selection.Paragraphs(i).Range.FormattedText
Next
End Sub
You will need to select the paragraphs first then run the Sub, it will duplicate the selected paragraphs at the end of the document but in the reverse order.
Related
My research shows that I need to use Visual Basic. I am a programmer/developer, but have never used VB so if anyone could dumb it down it would be appreciated.
Here's my working excel function:
=IF(MATCH(1,E1:DP1,0),D1,FALSE)
I want to loop a few of those numbers such that:
=IF(MATCH(141,E1:DP378,0),D378,FALSE)
THEN take my answers (which will be strings, because column D are all strings, the rest of the excel file are numbers)
=CONCAT
end goal: have 141 String arrays populated based on the data in my table.
I went ahead and made my first attempt at VBA like this:
Sub myFunc()
'Initialize Variables
Dim strings As Range, nums As Integer, answer() As Variant, listAnswers() As Variant
'set variables
strings = ("C1:C378")
nums = 141
i = 0
j = 0
ReDim Preserve answer(i)
ReDim Preserve listAnswers(j)
'answer() = {""}
'for each in nums
For counter = 0 To nums
ReDim Preserve listAnswers(0 To j)
'set each list of answers
listAnswers(i) = Join(answer(), "insertJSONcode")
j = j + 1
'for each in Stings
For Each cell In strings
If cell <> "" Then
ReDim Preserve answer(0 To i)
answer(i) = 'essentially this: (MATCH(2,E1:DP1,0),D1,FALSE)
i = i + 1
end If
next cell 'end embedded forEach
Next LCounter 'end for loop
'is this possible? or wrong syntax?
Range("A:A").Value = listAnswers() ' should print 141 arrays from A1 to A141
End Sub
EDIT:
Important note I do NOT need to call the sheet by Name. I've successfully written integer values to by excel sheet in column A without doing so.
Also, the VBA I wrote I was never intended to work, I know it's broken at least where answer(i) is supposed to write to something. I'm only putting that code there to show I was able to at least able to get into spitting distance of the proper logic and prove I've put some serious effort into solving the problem and give a rough starting point.
Here's an image of the excel format. Column C goes down to 378 and the numbers listed from E through DP are populated by a database. It consists of blank cells and numbers between 1 and 141.
Looking back at my if statement:
=IF(MATCH(2,E2:DP2,0),D2,FALSE)
If I were to type that exactly into cell B2 it would output the correct answer "text2". which is neat and all, but I need every instance of text 2 written out, then CONCAT those results. Easy so far, I could drag that down all the way through column B and have all of my "text" strings in one column, CONCAT that column and there's the answer. However I don't just need #2, I need each number between 1 and 141. Plus I want to avoid writing 141 columns with a CONCAT on top of each one.
I need to write a macro that will replace specific characters in a selected string with other specific characters. That is, for example, I may want to replace all a's with b's, all b's with c's, and so on.
I wrote this test macro just to see if I could replace characters. It gets stuck in an infinite loop replacing the first character in the selection with "1".
Dim obChar As Range 'Define a range variable
For Each obChar In Selection.Characters
obChar.Text = "1"
Next obChar
What am I doing wrong?
Try a reversed loop:
Dim i As Integer
For i = Selection.Characters.Count To 1 Step -1
Selection.Characters(i).Text = "1"
Next i
need some assistance. It's been a very long time since I've done scripting/coding and really rusty now.
Issue: I have a spreadsheet(Excel Visual Basic) that contains call(s) over a month(Over 30k records). My goal is to filter out calls that have specific area codes (toll free, local calls...etc) and calculate how much they owe from calling long distance.
Additionally, this is a retirement home and the end-user(s) do not enter phone numbers correctly. I need to either strip 3-4 digits at the start of numbers..
Example: 1800-XXX-XXXX or 800-XXX-XXXX | 1605-XXX-XXXX
Here's the code I currently have, I'm lost on how to incorporate the 3-4 digits in the area and have it parse each record in Column H by the first 3-4 digits
Phone numbers are stored in Column H
Array TFL will store all the area codes I need to filter out.
Sub CleanEntry()
Dim i As Integer
Dim TFL As Variant
TFL = Array("1800", "1877")
For i = Sheet1.UsedRange.Rows.Count To 1 Step -1
If Left(Cells(i, "H"), 4) Like TFL(i) Then
Sheet1.Rows(i).EntireRow.Delete
End If
Next
End Sub
I'd personally use a regular expression for this:
Sub CleanEntry()
Dim i As Integer
Dim filter As New RegExp
filter.Pattern = "^1?(8(77|00))|605" 'Or whatever else you need to match.
For i = Sheet1.UsedRange.Rows.Count To 1 Step -1
If filter.Test(Trim$(Cells(i, "H").Value)) Then
Sheet1.Rows(i).EntireRow.Delete
End If
Next
End Sub
Note: You'll need to add a reference to Microsoft VBScript Regular Expressions 5.5.
I have this data in Excel:
But one of my clients needs it summarize per item in detail.
So above data needs to be converted to:
This way, client can analyze it per tracking and per item.
The text format is not really uniform since it is entered manually.
Some users use Alt+Enter to separate items. Some uses space and some doesn't bother separating at all. What's consistent though is that they put hyphen(-) after the item then the count (although not always followed by the number, there can be spaces in between). Also if the count of that item is one(1), they don't bother putting it at all (as seen on the tracking IDU3004 for Apple Juice).
The only function I tried is the Split function which brings me closer to what I want.
But I am still having a hard time separating the individual array elements into what I expect.
So for example, IDU3001 in above after using Split (with "-" as delimiter) will be:
arr(0) = "Apple"
arr(1) = "20 Grape"
arr(2) = "5" & Chr(10) & "Pear" ~~> Just to show Alt+Enter
arr(3) = "3Banana"
arr(4) = "2"
Of course I can come up with a function to deal with each of the elements to extract numbers and items.
Actually I was thinking of using just that function and skip the Split altogether.
I was just curious that maybe there is another way out there since I am not well versed in Text manipulation. I would appreciate any idea that would point me to a possible better solution.
I suggest using a Regular Expression approach
Here's a demo based on your sample data.
Sub Demo()
Dim re As RegExp
Dim rMC As MatchCollection
Dim rM As Match
Dim rng As Range
Dim rw As Range
Dim Detail As String
' replace with the usual logic to get the range of interest
Set rng = [A2:C2]
Set re = New RegExp
re.Global = True
re.IgnoreCase = True
re.Pattern = "([a-z ]+[a-z])\s*\-\s*(\d+)\s*"
For Each rw In rng.Rows
' remove line breaks and leading/trailing spaces
Detail = Trim$(Replace(rw.Cells(1, 3).Value, Chr(10), vbNullString))
If Not Detail Like "*#" Then
' Last item has no - #, so add -1
Detail = Detail & "-1"
End If
' Break up string
If re.Test(Detail) Then
Set rMC = re.Execute(Detail)
For Each rM In rMC
' output Items and Qty's to Immediate window
Debug.Print rM.SubMatches(0), rM.SubMatches(1)
Next
End If
Next
End Sub
Based on your comment I haved assumed that only the last item in a cell may be missing a -#
Sample input
Apple Juice- 20 Grape -5
pear- 3Banana-2Orange
Produces this output
Apple Juice 20
Grape 5
pear 3
Banana 2
Orange 1
I am trying to shuffle the items in a numbered list in MS Word 2010. The background for this question is that my wife is an English teacher who makes her tests using Word. Whenever she makes a test she also makes a second version by changing the order of the items in the numbered lists.
I am looking to either:
change the order of items in a numbered list that I select using the mouse, ie select the numbered list, push a button/shortcut and the list is shuffled
or
change the order of all numbered lists in the test, ie the macro looks for the start of a new numbered list, selects all items in the list, changes the order of the items and then moves over to the next numbered list.
All lists should keep the same formatting (ie start number) after using the code.
I tried for the first instance but did not succeed in determining the start and end line numbers of my selection.
Example:
Original:
===== Start: ========
Question 1 What answer is correct?
Answer A
Answer B
Answer C
Question 2 What answer is correct?
Answer D
Answer E
Answer F
Question 3 What answer is correct?
Answer G
Answer H
Answer J
======End========
The macro should create this:
======Start========
Question 1 What answer is correct?
Answer C
Answer A
Answer B
Question 2 What answer is correct?
Answer F
Answer E
Answer D
Question 3 What answer is correct?
Answer H
Answer J
Answer G
====End======
Since you are dealing with only 3 list items, it is pretty easy. Just swap any of the two items. The following code does the same.
For more than 3 items, you may have to repeat the logic of swapping more rows. But you should get the basic idea about how to go about it from this code.
Sub Shuffle()
Dim li As List, rng As Range, random As Integer
Randomize
For Each li In ThisDocument.Lists
' get either 1 or 2. We will swap this with the 3rd item
random = CInt(Rnd + 1)
' add a new paragraph as temporary place holder. This is so that we can keep the paragraph with its formatting intact.
Set rng = li.Range.Paragraphs.Add.Range
rng.FormattedText = li.Range.Paragraphs(random).Range.FormattedText
' swap the items
li.Range.Paragraphs(random).Range.FormattedText = li.Range.Paragraphs(3).Range.FormattedText
li.Range.Paragraphs(3).Range.FormattedText = rng.FormattedText
' remove the temporary paragraph we added
li.Range.Paragraphs.Last.Range.Delete
Next
End Sub
I slightly modified the code by Pradeep Kumar and this works like a charm, even with an unknown number of items per numbered list and so that it can be incorporated in the normal.dot template:
Sub Shuffle()
Dim li As List, rng As Range, random As Integer, nbr As Integer
Application.ScreenUpdating = False
Randomize
For Each li In ActiveDocument.Lists
nbr = li.CountNumberedItems
' Run along all items in list and swap with a random one from the same list
For a_counter = 1 To nbr
' Make sure the item is not swapped with itself, that would fail
again:
random = CInt((nbr - 1) * Rnd + 1)
If random = a_counter Then GoTo again
' add a new paragraph as temporary place holder. This is so that we can keep the paragraph with its formatting intact.
Set rng = li.Range.Paragraphs.Add.Range
rng.FormattedText = li.Range.Paragraphs(random).Range.FormattedText
' swap the items
li.Range.Paragraphs(random).Range.FormattedText = li.Range.Paragraphs(a_counter).Range.FormattedText
li.Range.Paragraphs(a_counter).Range.FormattedText = li.Range.Paragraphs(nbr + 1).Range.FormattedText
' remove the temporary paragraph we added
li.Range.Paragraphs(nbr + 1).Range.Delete
Next a_counter
Next
Application.ScreenUpdating = True
End Sub