?
Solved

VB Array Sorting (EBCDIC)

Posted on 2010-11-29
14
Medium Priority
?
1,979 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 6
  • 6
14 Comments
 

Author Comment

by:Delerium1978
ID: 34231211
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 57

Expert Comment

by:Bill Prew
ID: 34231583
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
ID: 34231650
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
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 

Author Comment

by:Delerium1978
ID: 34231682
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 57

Expert Comment

by:Bill Prew
ID: 34264165
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
ID: 34265108
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
 

Author Comment

by:Delerium1978
ID: 34265111
oops this time with file :)
Input.txt
0
 
LVL 57

Expert Comment

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

~bp
0
 
LVL 57

Expert Comment

by:Bill Prew
ID: 34272121
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
ID: 34273278
Ill give it a whirl on Monday and try and supply a set of test data - thanks Bill.
0
 
LVL 57

Accepted Solution

by:
Bill Prew earned 2000 total points
ID: 34273766
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 57

Expert Comment

by:Bill Prew
ID: 34273774
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:Tracy
ID: 34459712
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

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
This article describes how you can use Custom Document Properties to store settings and other information in your workbook so that they will be available the next time you open the workbook.
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

718 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