asked on

How do I sort data alphabetically in a variable in vbscript, then show to the output window in my hta

I am hoping someone can offer some advice on how to sort the data stored in a variable alphabetically and then output to my output window. I know vbscript isn't the greatest for sorting data, but is it possible?

Here is the code for my hta

<html>
<head>
<title>Remove Blank Lines</title>
<HTA:APPLICATION
  SYSMENU="Yes"
  MAXIMIZEBUTTON="NO"
  MINIMIZEBUTTON="NO"
  BORDER="DIALOG"
  SCROLL="NO"
  APPLICATIONNAME="MyHTA"
  ID="MyHTA"
  VERSION="1.0"/>
</head>

<script language="VBScript">

Sub Window_OnLoad
  	Dim width,height
  	width=1000
  	height=500
  	self.ResizeTo width,height
  	self.MoveTo (screen.AvailWidth-width)/2,(screen.AvailHeight-height)/2
  'This method will be called when the application loads
  'Add your code here
    myVBSClock 
    iTimerID = window.setInterval("myVBSClock", 1200) 
End Sub

Sub OnClickButtonSubmit()

 	Set Dict = CreateObject("Scripting.Dictionary")
	
	strText = input.Value
	
	If strText = "" Then
		MsgBox "No Data in the Input box!" & vbCrLf & "Enter Data into the Input box for processing", vbOKOnly, "Error"
		Exit Sub
	End If
	
	txtInput = Split(strText, vbCrLf)
	
	MessageResult = MsgBox("     Select Yes to format the data, No to remove blank lines" & vbCrLf & vbCrLf & _
						"               DATA IS ALSO COPIED TO THE CLIPBOARD!", _
					 		vbYesNoCancel, "Question")

		
		Select Case MessageResult
		
			Case vbYes
			
				For i = 0 To UBound(txtInput)					
					If Not txtInput(i) = "" Then
						txtInput(i) = Trim(txtInput(i))						
							If Not LCase(Left(txtInput(i), 7)) = "version" Then
								If Not Dict.Exists(LCase(txtInput(i))) Then
									strNewContents = LCase(strNewContents & "Case" & vbTab & Chr(34) & txtInput(i) & _
										Chr(34) & vbCrLf)
									Dict.Add LCase(txtInput(i)), txtInput(i)
									
								End If
							End If
					End If
				Next
				output.value = strNewContents
				document.parentWindow.clipboarddata.setdata "text", strNewContents
			Case vbNo
			
					For i = 0 To UBound(txtInput)
					If Not txtInput(i) = "" Then
						txtInput(i) = Trim(txtInput(i))
							If Not LCase(Left(txtInput(i), 7)) = "version" Then
								If Not Dict.Exists(LCase(txtInput(i))) Then									
									strNewContents = LCase(strNewContents & txtInput(i) & vbCrLf)
									Dict.Add LCase(txtInput(i)), txtInput(i)								
								End If
							End If
					End If
				Next
				output.value = strNewContents
				document.parentWindow.clipboarddata.setdata "text", strNewContents
			Case Else
				output.value = ""
				strNewContents = ""		
				Exit Sub
				
		End Select
		
		Dict.RemoveAll	
	
End Sub

'I get an error trying to call this function

function SortArray(arrShort)
dim i, j, temp
for i = UBound(arrShort) - 1 To 0 Step -1
for j= 0 to i
if arrShort(j)>arrShort(j+1) then
temp=arrShort(j+1)
arrShort(j+1)=arrShort(j)
arrShort(j)=temp
end if
next
next
SortArray = arrShort
end function 

Sub OnClickButtonCloseApplication()
  'This method will be called when button "Close Application" is clicked
  'Add your code here
  Self.close
End Sub
Sub OnClickButtonclear()
  'This method will be called when button "clear" is clicked
  'Add your code here
  
  input.value = ""
  output.value = ""
End Sub

Sub myVBSClock
	myClock.innertext = Time()
End Sub
</script>

<body STYLE="font:14 pt arial; color:white;
 filter:progid:DXImageTransform.Microsoft.Gradient
(GradientType=0, StartColorStr='#FFE87C', EndColorStr='#544E4F')">

<!--Add your controls here-->

<div align="center" style="float:left; width:50%;font-family: cambria; font:16pt; font-weight: bold; color: black">Type or paste your text into the box on the left
</p>
</br>
</div>

<div align="center" style="float:right; width:50%;font-family: cambria; font:16pt; font-weight: bold; color: black">The result is shown on the right And is copied to the clipboard
</p>
</div>

<div align="center" style="float:left; width:50%">

<textarea style="background-color: #C9C299; font:12pt; font-family: cambria" name="Input" id="Input" rows="15" cols="40"></textarea> 

</div>


<div align="center" style="float:right; width:50%">

<textarea style="background-color: #C9C299;font:12pt; font-family: cambria" name="Output" id="Output" rows="15" cols="40" readonly="true"></textarea>

</div>

<div align="center">
<p></p>
<input type="button" style="height:25px;width:150px;font-weight: bold;font-family: cambria; background-color:#FFE87C; color:Black" name="CONVERT" id="CONVERT" value="CONVERT" onclick="OnClickButtonSubmit">
<input type="button" style="height:25px; width:150px;font-weight: bold;font-family: cambria; background-color:#FFE87C; color:Black" name="CLEAR" id="CLEAR" value="CLEAR" onclick="OnClickButtonclear">
<p></p>
</div>
</p>
</p>
<div align="Center"
<PRE ID=myClock style="float:right;color:#FFE87C; font-weight: bold; font-family: cambria">  </PRE>
<!--{{InsertControlsHere}}-Do not remove this line-->
</div>
</body>
</html>

Open in new window

ASKER CERTIFIED SOLUTION

Scott Fell

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Learning2Code

ASKER

I am not sure how to implement that into this script, I have never really worked with arrays before

	strText = input.Value
	
	If strText = "" Then
		MsgBox "No Data in the Input box!" & vbCrLf & "Enter Data into the Input box for processing", vbOKOnly, "Error"
		Exit Sub
	End If
	
	txtInput = Split(strText, vbCrLf)
	
	MessageResult = MsgBox("     Select Yes to format the data, No to remove blank lines" & vbCrLf & vbCrLf & _
						"               DATA IS ALSO COPIED TO THE CLIPBOARD!", _
					 		vbYesNoCancel, "Question")

		
		Select Case MessageResult
		
			Case vbYes
			
				For i = 0 To UBound(txtInput)					
					If Not txtInput(i) = "" Then
						txtInput(i) = Trim(txtInput(i))						
							If Not LCase(Left(txtInput(i), 7)) = "version" Then
								If Not Dict.Exists(LCase(txtInput(i))) Then
									strNewContents = LCase(strNewContents & "Case" & vbTab & Chr(34) & txtInput(i) & _
										Chr(34) & vbCrLf)
									Dict.Add LCase(txtInput(i)), txtInput(i)
									
								End If
							End If
					End If
				Next
				
				arrtxt = Split(strNewContents, vbcrlf)
				
				For i = UBound(arrtxt) -1 To 0 Step -1
					For j=0 To i
						If arrtxt(j)> arrtxt(j+1) Then
							temp = arrtxt(j+1) 
							arrtxt(j+1)=arrtxt(j)
							arrtxt(j)=temp
						End If
					Next
				Next
				
				output.value = myoutput

Open in new window

Learning2Code

ASKER

This seems to work, thanks for pointing me in the right direction

				arrtxt = Split(strNewContents, vbcrlf)
				
				For i = UBound(arrtxt) -1 To 0 Step -1
					For j=0 To i
						If arrtxt(j)> arrtxt(j+1) Then
							temp = arrtxt(j+1) 
							arrtxt(j+1)=arrtxt(j)
							arrtxt(j)=temp
						End If
					Next
				Next
				
				For i = 0 To UBound(arrtxt)
					If Not arrtxt(i) = "" Then					
						myoutput = myoutput & arrtxt(i) & vbCrLf
					End If
				Next

Open in new window

Learning2Code

ASKER

Thanks for pointing me in the right direction

Scott Fell

I'm sorry, I gave you the article for quick sort. Bubble sort is a lot less efficient but probably easier to understand http://www.4guysfromrolla.com/demos/bubblesort.asp

<%@ Language=VBScript %>
<% Option Explicit %>
<%
Sub SingleSorter( byRef arrArray )
    Dim row, j
    Dim StartingKeyValue, NewKeyValue, swap_pos

    For row = 0 To UBound( arrArray ) - 1
    'Take a snapshot of the first element
    'in the array because if there is a 
    'smaller value elsewhere in the array 
    'we'll need to do a swap.
        StartingKeyValue = arrArray ( row )
        NewKeyValue = arrArray ( row )
        swap_pos = row
	    	
        For j = row + 1 to UBound( arrArray )
        'Start inner loop.
            If arrArray ( j ) < NewKeyValue Then
            'This is now the lowest number - 
            'remember it's position.
                swap_pos = j
                NewKeyValue = arrArray ( j )
            End If
        Next
	    
        If swap_pos <> row Then
        'If we get here then we are about to do a swap
        'within the array.		
            arrArray ( swap_pos ) = StartingKeyValue
            arrArray ( row ) = NewKeyValue
        End If	
    Next
End Sub
%>
<html><body>
<h1>Bubble Sort for a One-Dimensional Array</h1>

<form method=post id=form1 name=form1>
  Enter a number of strings, each separated by a space (for example: <i>bob scott sue larry elvis</i>):<br>
  <textarea name="txtSearch" cols=50 rows=5><%=Request("txtSearch")%></textarea>
  <p><input type=submit value="Sort!" id=submit1 name=submit1>
</form>

<p><hr><P>

<% If Len(Request("txtSearch")) > 0 then
      Dim aDigits
      aDigits = split(Request("txtSearch"), " ")
      'Display the sorted array
      Response.Write "<b>Unsorted Array</b>: " & join(aDigits, ", ")

      SingleSorter aDigits
      
      'Display the sorted array
      Response.Write "<p><b>Sorted Array:</b> " & join(aDigits, ", ")
      
      Response.Write "<p><hr><p>"
   End IF
%>

Open in new window

Learning2Code

ASKER

Here is the complete code I have now that works perfect for what I need to do

<html>
<head>
<title>Remove Blank Lines</title>
<HTA:APPLICATION
  SYSMENU="Yes"
  MAXIMIZEBUTTON="NO"
  MINIMIZEBUTTON="NO"
  BORDER="DIALOG"
  SCROLL="NO"
  APPLICATIONNAME="MyHTA"
  ID="MyHTA"
  VERSION="1.0"/>
</head>

<script language="VBScript">

Sub Window_OnLoad
  	Dim width,height
  	width=1000
  	height=500
  	self.ResizeTo width,height
  	self.MoveTo (screen.AvailWidth-width)/2,(screen.AvailHeight-height)/2
  'This method will be called when the application loads
  'Add your code here
    myVBSClock 
    iTimerID = window.setInterval("myVBSClock", 1200) 
End Sub

Sub OnClickButtonSubmit()

 	Set Dict = CreateObject("Scripting.Dictionary")
	
	strText = input.Value
	
	If strText = "" Then
		MsgBox "No Data in the Input box!" & vbCrLf & "Enter Data into the Input box for processing", vbOKOnly, "Error"
		Exit Sub
	End If
	
	txtInput = Split(strText, vbCrLf)
	
	MessageResult = MsgBox("     Select Yes to format the data, No to remove blank lines" & vbCrLf & vbCrLf & _
						"               DATA IS ALSO COPIED TO THE CLIPBOARD!", _
					 		vbYesNoCancel, "Question")

		
		Select Case MessageResult
		
			Case vbYes
			
				For i = 0 To UBound(txtInput)					
					If Not txtInput(i) = "" Then
						txtInput(i) = Trim(txtInput(i))						
							If Not LCase(Left(txtInput(i), 7)) = "version" Then
								If Not Dict.Exists(LCase(txtInput(i))) Then
									strNewContents = LCase(strNewContents & "Case" & vbTab & Chr(34) & txtInput(i) & _
										Chr(34) & vbCrLf)
									Dict.Add LCase(txtInput(i)), txtInput(i)									
								End If
							End If
					End If
				Next
				
				arrtxt = Split(strNewContents, vbcrlf)
				
				For i = UBound(arrtxt) -1 To 0 Step -1
					For j=0 To i
						If arrtxt(j)> arrtxt(j+1) Then
							temp = arrtxt(j+1) 
							arrtxt(j+1)=arrtxt(j)
							arrtxt(j)=temp
						End If
					Next
				Next
				
				For i = 0 To UBound(arrtxt)
					If Not arrtxt(i) = "" Then					
						myoutput = myoutput & arrtxt(i) & vbCrLf
					End If
				Next
				
				output.value = myoutput				
				document.parentWindow.clipboarddata.setdata "text", myoutput
				
			Case vbNo
			
					For i = 0 To UBound(txtInput)
					If Not txtInput(i) = "" Then
						txtInput(i) = Trim(txtInput(i))
							If Not LCase(Left(txtInput(i), 7)) = "version" Then
								If Not Dict.Exists(LCase(txtInput(i))) Then									
									strNewContents = LCase(strNewContents & txtInput(i) & vbCrLf)
									Dict.Add LCase(txtInput(i)), txtInput(i)								
								End If
							End If
					End If
				Next
							arrtxt = Split(strNewContents, vbcrlf)
				
				For i = UBound(arrtxt) -1 To 0 Step -1
					For j=0 To i
						If arrtxt(j)> arrtxt(j+1) Then
							temp = arrtxt(j+1) 
							arrtxt(j+1)=arrtxt(j)
							arrtxt(j)=temp
						End If
					Next
				Next
				
				For i = 0 To UBound(arrtxt)
					If Not arrtxt(i) = "" Then					
						myoutput = myoutput & arrtxt(i) & vbCrLf
					End If
				Next
				
				output.value = myoutput				
				document.parentWindow.clipboarddata.setdata "text", myoutput
			
			Case Else
				output.value = ""
				strNewContents = ""		
				Exit Sub
				
		End Select
		
		Dict.RemoveAll	
	
End Sub

Sub OnClickButtonCloseApplication()
  'This method will be called when button "Close Application" is clicked
  'Add your code here
  Self.close
End Sub
Sub OnClickButtonclear()
  'This method will be called when button "clear" is clicked
  'Add your code here
  
  input.value = ""
  output.value = ""
End Sub

Sub myVBSClock
	myClock.innertext = Time()
End Sub
</script>

<body STYLE="font:14 pt arial; color:white;
 filter:progid:DXImageTransform.Microsoft.Gradient
(GradientType=0, StartColorStr='#FFE87C', EndColorStr='#544E4F')">

<!--Add your controls here-->

<div align="center" style="float:left; width:50%;font-family: cambria; font:16pt; font-weight: bold; color: black">Type or paste your text into the box on the left
</p>
</br>
</div>

<div align="center" style="float:right; width:50%;font-family: cambria; font:16pt; font-weight: bold; color: black">The result is shown on the right And is copied to the clipboard
</p>
</div>

<div align="center" style="float:left; width:50%">

<textarea style="background-color: #C9C299; font:12pt; font-family: cambria" name="Input" id="Input" rows="15" cols="40"></textarea> 

</div>


<div align="center" style="float:right; width:50%">

<textarea style="background-color: #C9C299;font:12pt; font-family: cambria" name="Output" id="Output" rows="15" cols="40" readonly="true"></textarea>

</div>

<div align="center">
<p></p>
<input type="button" style="height:25px;width:150px;font-weight: bold;font-family: cambria; background-color:#FFE87C; color:Black" name="CONVERT" id="CONVERT" value="CONVERT" onclick="OnClickButtonSubmit">
<input type="button" style="height:25px; width:150px;font-weight: bold;font-family: cambria; background-color:#FFE87C; color:Black" name="CLEAR" id="CLEAR" value="CLEAR" onclick="OnClickButtonclear">
<p></p>
</div>
</p>
</p>
<div align="Center"
<PRE ID=myClock style="float:right;color:#FFE87C; font-weight: bold; font-family: cambria">  </PRE>
<!--{{InsertControlsHere}}-Do not remove this line-->
</div>
</body>
</html>

Open in new window