Hi guys i am hoping that you guys can point me in the right direction. I am trying to come up with a macro that will sort words in ascending order for each paragraph. To make it clear i am giving an example below:
The quick brown fox jumps over the lazy dog. <---- given
brown dog fox jumps lazy over quick the the <---- the output
The output should show below the para/s right at the end of the docu already sorted. Any help or advice as to how i can go about it using Ranges, pls let me know. thanks!
I believe this code might point you in the right direction.
Notice you'll need to add somewhere the sorted array (as of now, it's only sorting the array values).
I used the sorting function available HERE.
Hope it helps!
Option Explicit
Option Compare Text
Sub orderParagraph()
Dim oParagraph As Word.Paragraph
Dim vParagraphText As Variant
For Each oParagraph In ActiveDocument.Paragraphs
If Len(Trim(oParagraph.Range.Text)) > 0 Then
vParagraphText = oParagraph.Range.Text
vParagraphText = Split(vParagraphText, " ")
SortArray vParagraphText
End If
Next oParagraph
End Sub
Private Function SortArray(ByRef TheArray As Variant)
Dim x As Integer
Dim bSorted As Boolean
Dim sTempText As String
bSorted = False
Do While Not bSorted
bSorted = True
For x = 0 To UBound(TheArray) - 1
If TheArray(x) > TheArray(x + 1) Then
sTempText = TheArray(x + 1)
TheArray(x + 1) = TheArray(x)
TheArray(x) = sTempText
bSorted = False
End If
Next x
Loop
End Function
Related
Hello there everyone.
I have little problem, didn't make sense at all. So i have kinda simple for loop. I want to create random integers and remove index of specific array by that integer.
Working perfect:
For i = 1 To CInt(rastgelesoru.Text)
Dim Rand As New Random()
Dim xIndex As Integer = Rand.Next(0, AList.Count - 1)
Dim SelectedValue = AList(xIndex)
Dim eklepanelrnd As Panel = CType(containerpanel.Controls(SelectedValue), Panel)
If eklepanelrnd.Tag = "1" Then
MsgBox(xIndex)
containerpanelrastgele.Controls.Add(eklepanelrnd)
End If
AList.RemoveAt(xIndex)
Next
For example i have 500 element in array. When i add message box like above, it works perfect. I get random numbers. (100,65,355,27,472 last output for 5). But when i remove msgbox line i get Consecutive numbers everytime. First i thought it might be really 'random' but no. Everytime i get Consecutives. (23,24,25,160,161 last output for 5 without msgbox line.)
Not working properly without msgbox line.
For i = 1 To CInt(rastgelesoru.Text)
Dim Rand As New Random()
Dim xIndex As Integer = Rand.Next(0, AList.Count - 1)
Dim SelectedValue = AList(xIndex)
Dim eklepanelrnd As Panel = CType(containerpanel.Controls(SelectedValue), Panel)
If eklepanelrnd.Tag = "1" Then
containerpanelrastgele.Controls.Add(eklepanelrnd)
End If
AList.RemoveAt(xIndex)
Next
#AlexB. on comments.
Don´t create Random objects in your loop but only create one. So move Dim Rand As New Random() before the loop.
Working perfect now. Thanks <3 Have a wonderful day.
So I have been trying to make every 3 words in a word docuemnt bold in a specific selection or if there is nothing selected every 3 words in the whole document. I tried different approaches but nothing worked.
I should say "What have you tried so far?" and "Lets see your code.", but I haven't really coded in Word so thought I'd give it a go....
This seems to do the trick, although there may be a much better way to code it:
Public Sub BoldText()
Dim wrd As Range
Dim x As Long
Dim doc As Variant
If Selection.Start = Selection.End Then
Set doc = ThisDocument
Else
Set doc = Selection
End If
x = 0
For Each wrd In doc.Words
x = x + 1
If x Mod 3 = 0 Then
wrd.Bold = True
End If
Next wrd
End Sub
I am trying to write a code for a search button which searches a listbox based a specific input set in a textbox.
The values searched are always numbers, and the listbox contains values from a single column.
The code i wrote can be found below but i don't understand why it is not functional.
Legend:
SearchButton: A Button which upon clicking is supposed to initiate the search
SearchBox: The textbox which will contain the search value
AvailableNumberList: The listbox which contains the data
Thanks for your help :)
Private Sub SearchButton_Click()
Dim SearchCriteria, i, n As Double
SearchCriteria = Me.SearchBox.Value
n = AvailableNumberList.ListCount
For i = 0 To n - 1
If SearchCriteria = i Then
AvailableNumberList.ListIndex = i
End If
Next i
End Sub
Is this what you are trying?
'If SearchCriteria = i Then
If AvailableNumberList.List(i) = SearchCriteria Then
Also use Exit For once a match is found :)
Additional to #Siddharth Rout solution, this code allows to search in the ListBox even if the TextBox does not have the full word/number:
Private Sub SearchButton_Click()
Dim SearchCriteria, i, n As Double
SearchCriteria = Me.SearchBox.Value
n = AvailableNumberList.ListCount
For i = 0 To n - 1
If Left(AvailableNumberList.List(i),Len(SearchCriteria))=SearchCriteria Then
AvailableNumberList.ListIndex = i
Exit For
End If
Next i
End Sub
Thanks everyone for their code! =D
I need to fill an array with numbers 1-50, and I currently have the code:
Dim numberSet(49)
For x = 1 To 50
numberSet(x - 1) = x
Next x
The challenge is to do it in the least amount of lines possible. This part is bugging me because it seems like i shouldn't be using 4 lines for something so basic.
Any thoughts from you guys? I want to avoid doing something like = {1,2,3,4,5...50} if I can. Thanks!
In one line:
Dim numberSet(49): For x = 1 To 50: numberSet(x - 1) = x: Next x
One line (but it creates a 1-based array...)
Sub TT()
Dim arr
arr = Application.Transpose([=ROW(A1:A50)])
Debug.Print UBound(arr)
Debug.Print arr(1)
Debug.Print arr(13)
End Sub
...and if you turn off Option Explicit you can skip the declaration. But don't do that ;-)
I'm writing a script that will count a numbers of days between few separate dates. I have a data in cell like:
1-In Progress#02-ASSIGNED TO TEAM#22/01/2013 14:54:23,4-On
Hold#02-ASSIGNED TO TEAM#18/01/2013 16:02:03,1-In Progress#02-ASSIGNED
TO TEAM#18/01/2013 16:02:03
That's the info about my transaction status. I want to count the numbers of days that this transaction was in "4-On Hold". So in this example it will be between 18/01/2013 and 22/01/2013.
I wrote something like this(sorry for ma native language words in text)
Sub Aktywnywiersz()
Dim wiersz, i, licz As Integer
Dim tekstwsadowy As String
Dim koniectekstu As String
Dim pozostalytekst As String
Dim dataztekstu As Date
Dim status4jest As Boolean
Dim status4byl As Boolean
Dim datarozpoczecia4 As Date
Dim datazakonczenia4 As Date
Dim dniw4 As Long
wiersz = 2 'I start my scrypt from second row of excel
Do Until IsEmpty(Cells(wiersz, "A")) 'this should work until there is any text in a row
status4jest = False 'is status 4-On Hold is now in a Loop
status4byl = False 'is status 4-On Hold was in las loop
dniw4 = 0 ' numbers od days in 4-On Hold status
tekstwsadowy = Cells(wiersz, "H").Value2 'grabing text
tekstwsadowy = dodanieprzecinka(tekstwsadowy) 'in some examples I had to add a coma at the end of text
For i = 1 To Len(tekstwsadowy)
If Right(Left(tekstwsadowy, i), 1) = "," Then licz = licz + 1 'count the number of comas in text that separates the changes in status
Next
For j = 1 To licz
koniectekstu = funkcjaliczeniadni(tekstwsadowy) 'take last record after coma
Cells(wiersz, "k") = koniectekstu
dataztekstu = funkcjadataztekstu(koniectekstu) 'take the date from this record
Cells(wiersz, "m") = dataztekstu
status4jest = funkcjaokreslenia4(koniectekstu) 'check if there is 4-On Hold in record
Cells(wiersz, "n") = status4jest
If (status4byl = False And staus4jest = True) Then
datarozpoczecia4 = dataztekstu
status4byl = True
ElseIf (status4byl = True And staus4jest = False) Then
datazakonczenia4 = dataztekstu
status4byl = False 'if elseif funkcion to check information about 4-On Hold
dniw4 = funkcjaobliczeniadniw4(dniw4, datazakonczenia4, datarozpoczecia4) 'count days in 4-On Hold
Else
'Else not needed...
End If
tekstwsadowy = resztatekstu(tekstwsadowy, koniectekstu) 'remove last record from main text
Next
Cells(wiersz, "L") = dniw4 ' show number of days in 4-On Hold status
wiersz = wiersz + 1
Loop
End Sub
Function funkcjaliczeniadni(tekstwsadowy As String)
Dim a, dl As Integer
dl = Len(tekstwsadowy)
a = 0
On Error GoTo errhandler:
Do Until a > dl
a = Application.WorksheetFunction.Find(",", tekstwsadowy, a + 1)
Loop
funkcjaliczeniadni = tekstwsadowy
Exit Function
errhandler:
funkcjaliczeniadni = Right(tekstwsadowy, dl - a)
End Function
Function dodanieprzecinka(tekstwsadowy As String)
If Right(tekstwsadowy, 1) = "," Then
dodanieprzecinka = Left(tekstwsadowy, Len(tekstwsadowy) - 1)
Else
dodanieprzecinka = tekstwsadowy
End If
End Function
Function resztatekstu(tekstwsadowy, koniectekstu As String)
resztatekstu = Left(tekstwsadowy, Len(tekstwsadowy) - Len(koniectekstu))
End Function
Function funkcjadataztekstu(koniectekstu As String)
funkcjadataztekstu = Right(koniectekstu, 19)
funkcjadataztekstu = Left(funkcjadataztekstu, 10)
End Function
Function funkcjaobliczeniadniw4(dniw4 As Long, datazakonczenia4 As Date, datarozpoczecia4 As Date)
Dim liczbadni As Integer
liczbadni = DateDiff(d, datarozpoczecia4, datazakonczenia4)
funkcjaobliczaniadniw4 = dniw4 + liczbadni
End Function
Function funkcjaokreslenia4(koniectekstu As String)
Dim pierwszyznak As String
pierwszyznak = "4"
If pierszyznak Like Left(koniectekstu, 1) Then
funkcjaokreslenia4 = True
Else
funkcjaokreslenia4 = False
End If
End Function
And for now I get
Run-time error "13"
in
dataztekstu = funkcjadataztekstu(koniectekstu) 'take the date from this record
I would be very grateful for any help.
You are getting that error because of Type Mismatch. dataztekstu is declared as a date and most probably the expression which is being returned by the function funkcjadataztekstu is not a date. You will have to step through it to find what value you are getting in return.
Here is a simple example to replicate that problem
This will give you that error
Option Explicit
Sub Sample()
Dim dt As String
Dim D As Date
dt = "Blah Blah"
D = getdate(dt)
Debug.Print D
End Sub
Function getdate(dd As String)
getdate = dd
End Function
This won't
Option Explicit
Sub Sample()
Dim dt As String
Dim D As Date
dt = "12/12/2014"
D = getdate(dt)
Debug.Print D
End Sub
Function getdate(dd As String)
getdate = dd
End Function
If you change your function to this
Function funkcjadataztekstu(koniectekstu As String)
Dim temp As String
temp = Right(koniectekstu, 19)
temp = Left(temp, 10)
MsgBox temp '<~~ This will tell you if you are getting a valid date in return
funkcjadataztekstu = temp
End Function
Then you can see what that function is returning.
I tried running your code, but it is a little difficult to understand just what it is that you want to do. Part of it is the code in your language, but the code is also hard to read beacuse of the lack of indentation etc. :)
Also, I do not understand how the data in the worksheet looks. I did get it running by guessing, though, and when I did I got the same error you are describing on the second run of the For loop - that was because the koniectekstu string was empty. Not sure if this is your problem, so my solution is a very general.
In order to solve this type of problem:
Use Option Explicit at the top of your code module. This will make you have to declare all variables used in the module, and you will remove many of the problems you have before you run the code. Eg you are declaring a variable status4jest but using a different variable called staus4jest and Excel will not complain unless you use Option Explicit.
Declare return types for your functions.
Format your code so it will be easier to read. Use space before and after statements. Comment everything! You have done some, but make sure a beginner can understand. I will edit you code as an example of indentation.
Debug! Step through your code using F8 and make sure all variables contain what you think they do. You will most likely solve your problem by debugging the code this way.
Ask for help here on specific problems you run into or how to solve specific problems, do not send all the code and ask why it is not working. If you break down your problems into parts and ask separately, you will learn VBA yourself a lot faster.
A specific tip regarding your code: look up the Split function. It can take a string and make an array based on a delimiter - Example: Split(tekstwsadowy, ",") will give you an array of strings, with the text between the commas.
Did I mention Option Explicit? ;)
Anyway, I hope this helps, even if I did not solve the exact error you are getting.