Solved

VB Array Sorting (EBCDIC)

Posted on 2010-11-29
14
1,837 Views
Last Modified: 2012-05-10
Hi Guys, Im trying to create a sub that takes an array, sorts it in EBCDIC standard, then assigns a sequence number to it. Let me explain to start.

I have a two column set of data. Lets call them MAIN and SUB so:

MAIN     SUB
ITEM1     SUB1
ITEM1     SUB2
ITEM1     SUB3
ITEM1     SUB4
ITEM2     SUB1
ITEM2     SUB2

I want to join MAIN and SUB together, do a sort within the array in EBCDIC standard. Once I have this, for each row in the array, i want to assign it a sequence number like follows:

MAIN     SUB         SEQUENCE
ITEM1     SUB1          1
ITEM1     SUB2          2
ITEM1     SUB3          3
ITEM1     SUB4          4
ITEM2     SUB1          1
ITEM2     SUB2          2

so essentially the sequence is the position of the SUB entry within a unique MAIN.

Now ive not worked with arrays with more than one element to it so im completley at the mercy of you guys on this as im really not sure where to start.

Whilst i've also listed this question in the excel forum - all of this needs to be done in vba and not on any worksheets (only using one of excels addin functions to receive the dataset from a remote server).

Any clues?

James
0
Comment
Question by:Delerium1978
  • 6
  • 6
14 Comments
 

Author Comment

by:Delerium1978
Comment Utility
some guy posted an excel function to make a field that you could sort on to make it EBCDIC compliant but im not sure it helps my solution. Link to his function was http://www.mvps.org/dmcritchie/excel/sorting.htm

James
0
 
LVL 51

Expert Comment

by:Bill Prew
Comment Utility
So you want to do this outside of Excel, in a standalone VB script?

And is it the combination (concatenation) of MAIN and SUB that need to be sorted?

What characters need to be accounted for, is it just numbers and letters, or other special characters?  Also, will the input contain mixed case letters?

~bp
0
 

Author Comment

by:Delerium1978
Comment Utility
Its going to be run within excel as an excel macro but what I mean is the solution im looking for shouldn't use the worksheets and sorting on them as part of the solution - hoping for a complete vb solution.

The sorting is ideally by MAIN and SUB but my idea of concatenation and sorting on the concat would probably suffice too as long as I can split them in two again to end up with the MAIN, SUB and Sequence fields.

The fields of main and sub could contain any number, letter, $, £, -

Cheers

James
0
 

Author Comment

by:Delerium1978
Comment Utility
to expand a little further on what im trying to achieve - my full solution in my head is:

1. Select a list of MAINS and SUBS in an excel worksheet (I'm Ok with this step)
2. Create an array from listing and run SQL command on remote server (I'm Ok with this step)
3. Receive results from remote server and put into an array (I'm Ok with this step)
4. Sort received array in EBCDIC format
5. Loop through array and assign sequence numbers for each unique MAIN.
6. Return the sequence number based on MAIN/SUB combination back to excel for each row selected.

Hope this is clear.

james
0
 
LVL 51

Expert Comment

by:Bill Prew
Comment Utility
Okay, this is actually a bit tricky, but I may have a way to get the desired results.

Can you validate that these are the characters to be handled, and that they currently sort in this order in ascii mode:

$-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz£

and they would need to be sorted in this order in ebcdic mode:

£$-abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789

~bp
0
 

Author Comment

by:Delerium1978
Comment Utility
Hi Bill

Thought it would be tricky, struggling to even think of a way to start.

I've attached a text file which is CSV showing the sort orders of EBCDIC and ASCII. Fields are:

EBCDIC
EBCDIC Description
ASCII
ASCII Description

but i think what you posted was right on the money for the characters i wanted.

James
0
Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

 

Author Comment

by:Delerium1978
Comment Utility
oops this time with file :)
Input.txt
0
 
LVL 51

Expert Comment

by:Bill Prew
Comment Utility
Would it be possible for you to supply a test set of data, and the expected sorted output of this function?

~bp
0
 
LVL 51

Expert Comment

by:Bill Prew
Comment Utility
Well, here's a first attempt.  If you can try it against some more meaningful data we can refine as needed.  There isn't any error checking in it either right now, so we might want to add some of that, but wanted to get something to you to poke at.

~bp

aInput = Array("one","222","three","444","Five")

Wscript.Echo "BEFORE"
For Each sItem in aInput
   Wscript.Echo sItem
Next

DoSort aInput

Wscript.Echo "AFTER"
For Each sItem in aInput
   Wscript.Echo sItem
Next

Wscript.Quit

Sub DoSort(aIn())
   ReDim aSort(UBound(aIn)+1, 2)
   Dim aTemp(2)

   For i = 0 To UBound(aIn)
      aSort(i, 0) = aIn(i)
      aSort(i, 1) = ToEbcdic(aIn(i))
   Next

   For i = UBound(aIn) - 1 To 0 Step -1
       For j = 0 To i
           If aSort(j, 1) > aSort(j+1, 1) Then
               aTemp(0) = aSort(j+1, 0)
               aTemp(1) = aSort(j+1, 1)
               aSort(j+1, 0) = aSort(j, 0)
               aSort(j+1, 1) = aSort(j, 1)
               aSort(j, 0) = aTemp(0)
               aSort(j, 1) = aTemp(1)
           End if
       Next
   Next 

   For i = 0 To UBound(aIn)
      aIn(i) = i & " = " & aSort(i, 0)
   Next
End Sub

Function ToEbcdic(sIn)
   Const cMap = "£$-abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
   ToEbcdic = ""
   For i = 1 To Len(sIn)
      ToEbcdic = ToEbcdic & Chr(Instr(cMap, Mid(sIn, i, 1)))
   Next
End Function

Open in new window

0
 

Author Comment

by:Delerium1978
Comment Utility
Ill give it a whirl on Monday and try and supply a set of test data - thanks Bill.
0
 
LVL 51

Accepted Solution

by:
Bill Prew earned 500 total points
Comment Utility
Okay, did a little more work on that prior version and found a few flaws.  Here's a more robust version that I think should work pretty well.  It can handle any characters in the ASCII input now too.  Let me know how this goes.  Keep in mind this is VBS, not VBA code.  It will need to be adjusted to work in VBA, but to get it this close I worked in VBS.  WOn't be too hard to adapt to VBA, let me know if you need help with that.

~bp

Option Explicit
' Conversion tables adapted from: http://support.microsoft.com/kb/216399

' Return values from MyComp()
Const cCompLT = -1
Const cCompEQ = 0
Const cCompGT = 1
Const cCompNull = Null
Const cDebug = 1

Dim sA2E, sE2A
Dim aInput, sItem

' Build conversion tables
sA2E = ASCII_To_EBCDIC_Table()
sE2A = EBCDIC_To_ASCII_Table()

' Some test data
aInput = Array("Five","444","three","222","one", "$10", "three")

' Display array (before sort)
Wscript.Echo "BEFORE"
For Each sItem in aInput
   Wscript.Echo sItem
Next

' Sort the array by EBCDIC collating sequence
DoSort aInput

' Display array (after sort)
Wscript.Echo "AFTER"
For Each sItem in aInput
   Wscript.Echo sItem
Next

' Done
Wscript.Quit


Sub DoSort(aIn())
' Subroutine to sort one dimensional input text array in EBCDIC collation
' Uses a work 2 dimensional array, with the input (ASCII) value in aSort(i, 0)
' and the converted (EBCDIC) value in aSort(i, 1).  Then we do a basic 
' bubble sort keying off the EBCDIC value, and reloaf the input array with
' the sorted ASCII values.

   ' Define temp array for sorted result, and work area for element swaps
   ReDim aSort(UBound(aIn)+1, 2)
   Dim aTemp(2)
   Dim i, j

   ' Copy the input array values to work sort array
   For i = 0 To UBound(aIn)
      aSort(i, 0) = aIn(i)
      aSort(i, 1) = Translate(aIn(i), sA2E)
      If cDebug Then Wscript.Echo "ASCII:(" & aSort(i, 0) & "), EBCDIC:(" & ShowHex(aSort(i, 1)) & ")"
   Next

   ' Do basic bubble sort keying off EBCDIC values
   For i = UBound(aIn) - 1 To 0 Step -1
       For j = 0 To i
           If MyComp(aSort(j, 1), aSort(j+1, 1)) = cCompGT Then
               ' Swap element j with element j+1 (needs temp holding area)
               aTemp(0) = aSort(j+1, 0)
               aTemp(1) = aSort(j+1, 1)
               aSort(j+1, 0) = aSort(j, 0)
               aSort(j+1, 1) = aSort(j, 1)
               aSort(j, 0) = aTemp(0)
               aSort(j, 1) = aTemp(1)
           End if
       Next
   Next 

   ' Place the sorted version of ASCII values back into input array
   For i = 0 To UBound(aIn)
      aIn(i) = i & " = " & aSort(i, 0)
   Next
End Sub

Function Translate(ByVal sIn, sTable)
' Uses a translation table to map text from one character set to another
  Dim i, sTemp
  sTemp = ""
  For i = 1 To Len(sIn)
    sTemp = sTemp & Mid(sTable, Asc(Mid(sIn, i, 1)) + 1, 1)  
  Next
  Translate = sTemp
End Function

Function ASCII_To_EBCDIC_Table()
' Returns the following table as a string for use by the Translate
' function to translate an EBCDIC string to an ASCII-ISO/ANSI string.
'
' 00 01 02 03 37 2D 2E 2F 16 05 25 0B 0C 0D 0E 0F
' 10 11 12 13 3C 3D 32 26 18 19 3F 27 1C 1D 1E 1F
' 40 5A 7F 7B 5B 6C 50 7D 4D 5D 5C 4E 6B 60 4B 61
' F0 F1 F2 F3 F4 F5 F6 F7 F8 F9 7A 5E 4C 7E 6E 6F
' 7C C1 C2 C3 C4 C5 C6 C7 C8 C9 D1 D2 D3 D4 D5 D6
' D7 D8 D9 E2 E3 E4 E5 E6 E7 E8 E9 AD E0 BD 5F 6D
' 79 81 82 83 84 85 86 87 88 89 91 92 93 94 95 96
' 97 98 99 A2 A3 A4 A5 A6 A7 A8 A9 C0 4F D0 A1 07
' 20 21 22 23 24 15 06 17 28 29 2A 2B 2C 09 0A 1B
' 30 31 1A 33 34 35 36 08 38 39 3A 3B 04 14 3E E1
' 41 42 43 44 45 46 47 48 49 51 52 53 54 55 56 57
' 58 59 62 63 64 65 66 67 68 69 70 71 72 73 74 75
' 76 77 78 80 8A 8B 8C 8D 8E 8F 90 9A 9B 9C 9D 9E
' 9F A0 AA AB AC 4A AE AF B0 B1 B2 B3 B4 B5 B6 B7
' B8 B9 BA BB BC 6A BE BF CA CB CC CD CE CF DA dB
' DC DD DE DF EA EB EC ED EE EF FA FB FC FD FE FF
'
  ASCII_To_EBCDIC_Table = _
  HexToStr("00010203372D2E2F1605250B0C0D0E0F101112133C3D322618193F271C1D1E1F") & _
  HexToStr("405A7F7B5B6C507D4D5D5C4E6B604B61F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F") & _
  HexToStr("7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6D7D8D9E2E3E4E5E6E7E8E9ADE0BD5F6D") & _
  HexToStr("79818283848586878889919293949596979899A2A3A4A5A6A7A8A9C04FD0A107") & _
  HexToStr("202122232415061728292A2B2C090A1B30311A333435360838393A3B04143EE1") & _
  HexToStr("4142434445464748495152535455565758596263646566676869707172737475") & _
  HexToStr("767778808A8B8C8D8E8F909A9B9C9D9E9FA0AAABAC4AAEAFB0B1B2B3B4B5B6B7") & _
  HexToStr("B8B9BABBBC6ABEBFCACBCCCDCECFDADBDCDDDEDFEAEBECEDEEEFFAFBFCFDFEFF")
End Function

Function EBCDIC_To_ASCII_Table()
' Returns the following table as a string for use by the Translate
' function to traslate an EBCDIC string to an ASCII-ISO/ANSI string.
'
' 00 01 02 03 9C 09 86 7F 97 8D 8E 0B 0C 0D 0E 0F    ....œ.†-Ž.....
' 10 11 12 13 9D 85 08 87 18 19 92 8F 1C 1D 1E 1F    ........‡..'....
' 80 81 82 83 84 0A 17 1B 88 89 8A 8B 8C 05 06 07    €‚ƒ"...ˆ‰Š‹Œ...
' 90 91 16 93 94 95 96 04 98 99 9A 9B 14 15 9E 1A    '.""•-.˜(tm)š›..ž.
' 20 A0 A1 A2 A3 A4 A5 A6 A7 A8 D5 2E 3C 28 2B 7C    . ¡¢£¤¥¦§...<(+|
' 26 A9 AA AB AC AD AE AF B0 B1 21 24 2A 29 3B 5E    &(c)ª"¬­(r)¯°±!$*);^
' 2D 2F B2 B3 B4 B5 B6 B7 B8 B9 E5 2C 25 5F 3E 3F    -/²³´µ¶·¸¹.,%_>?
' BA BB BC BD BE BF C0 C1 C2 60 3A 23 40 27 3D 22    º"1/41/23/4¿...`:#@'="
' C3 61 62 63 64 65 66 67 68 69 C4 C5 C6 C7 C8 C9    .abcdefghi......
' CA 6A 6B 6C 6D 6E 6F 70 71 72 CB CC CD CE CF D0    .jklmnopqr......
' D1 7E 73 74 75 76 77 78 79 7A D2 D3 D4 5B D6 D7    .~stuvwxyz...[..
' D8 D9 DA DB DC DD DE DF E0 E1 E2 E3 E4 5D E6 E7    .............]..
' 7B 41 42 43 44 45 46 47 48 49 E8 E9 EA EB EC ED    {ABCDEFGHI......
' 7D 4A 4B 4C 4D 4E 4F 50 51 52 EE EF F0 F1 F2 F3    }JKLMNOPQR......
' 5C 9F 53 54 55 56 57 58 59 5A F4 F5 F6 F7 F8 F9    \.STUVWXYZ......
' 30 31 32 33 34 35 36 37 38 39 FA FB FC FD FE FF    0123456789......
'
  EBCDIC_To_ASCII_Table = _
  HexToStr("000102039C09867F978D8E0B0C0D0E0F101112139D8508871819928F1C1D1E1F") & _
  HexToStr("80818283840A171B88898A8B8C050607909116939495960498999A9B14159E1A") & _
  HexToStr("20A0A1A2A3A4A5A6A7A8D52E3C282B7C26A9AAABACADAEAFB0B121242A293B5E") & _
  HexToStr("2D2FB2B3B4B5B6B7B8B9E52C255F3E3FBABBBCBDBEBFC0C1C2603A2340273D22") & _
  HexToStr("C3616263646566676869C4C5C6C7C8C9CA6A6B6C6D6E6F707172CBCCCDCECFD0") & _
  HexToStr("D17E737475767778797AD2D3D45BD6D7D8D9DADBDCDDDEDFE0E1E2E3E45DE6E7") & _
  HexToStr("7B414243444546474849E8E9EAEBECED7D4A4B4C4D4E4F505152EEEFF0F1F2F3") & _
  HexToStr("5C9F535455565758595AF4F5F6F7F8F930313233343536373839FAFBFCFDFEFF")
End Function

Function HexToStr(sHexStr)
' Convert hex string data to string of hex bytes
  Dim i, sTemp
  sTemp = ""
  For i = 1 To Len(sHexStr) \ 2
    sTemp = sTemp & Chr(CInt("&H" & Mid(sHexStr, i * 2 - 1, 2)))
  Next
  HexToStr = sTemp
End Function

Function MyComp(sIn1, sIn2)
' Compare two strings in a text mode, but ignoring any collation
' (do a byte by byte value compare)

   Dim i, iLen

   ' Assume they are equal for now
   MyComp = 0

   ' If either is NULL then don't compare, return NULL
   If sIn1 = Null Or sIn2 = Null Then
      MyComp = Null
   Else
      ' Byte by byte compare until matching bytes not equal
      iLen = Len(sIn1)
      If iLen > Len(sIn2) Then
         iLen = Len(sIn2)
      End If
      For i = 1 to iLen
         If Asc(Mid(sIn1, i, 1)) > Asc(Mid(sIn2, i, 1)) Then
            MyComp = 1
            Exit For
         End If
         If Asc(Mid(sIn1, i, 1)) < Asc(Mid(sIn2, i, 1)) Then
            MyComp = -1
            Exit For
         End If
      Next
   End If

   ' If all matching bytes were the same, then see if lengths differed
   If MyComp = 0 Then
      If Len(sIn1) > Len(sIn2) Then
         MyComp = 1
      End If
      If Len(sIn2) > Len(sIn1) Then
         MyComp = -1
      End If
   End If
End Function

Function ShowHex(sIn)
' For debugging, format a string of bytes into hex display mode
   Dim i, sTemp
   sTemp = ""
   For i = 1 to Len(sIn)
      sTemp = sTemp & "[" & Hex(Asc(Mid(sIn, i, 1))) & "],"
   Next
   ShowHex = sTemp
End Function

Open in new window

0
 
LVL 51

Expert Comment

by:Bill Prew
Comment Utility
This was the output of my test run here in vbscript.

~bp

[c:\temp]cscript //nologo EE26644590.vbs
BEFORE
Five
444
three
222
one
$10
three
ASCII:(Five), EBCDIC:([C6],[89],[A5],[85],)
ASCII:(444), EBCDIC:([F4],[F4],[F4],)
ASCII:(three), EBCDIC:([A3],[88],[99],[85],[85],)
ASCII:(222), EBCDIC:([F2],[F2],[F2],)
ASCII:(one), EBCDIC:([96],[95],[85],)
ASCII:($10), EBCDIC:([5B],[F1],[F0],)
ASCII:(three), EBCDIC:([A3],[88],[99],[85],[85],)
AFTER
0 = $10
1 = one
2 = three
3 = three
4 = Five
5 = 222
6 = 444

Open in new window

0
 
LVL 24

Expert Comment

by:broomee9
Comment Utility
This question has been classified as abandoned and is being closed as part of the Cleanup Program.  See my comment at the end of the question for more details.
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

This is pretty cool.  The purpose of this VB Script is to help you document where JAR (Java ARchive) files and specifically java class files are located so that you can address issues seen with a client or that you can speak intelligently with a dev…
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
The viewer will learn how to simulate a series of sales calls dependent on a single skill level and learn how to simulate a series of sales calls dependent on two skill levels. Simulating Independent Sales Calls: Enter .75 into cell C2 – “skill leve…
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…

763 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

6 Experts available now in Live!

Get 1:1 Help Now