View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
c1802362[_2_] c1802362[_2_] is offline
external usenet poster
 
Posts: 65
Default Looking for a more elegant way to program code

On Mar 1, 2:52 am, "Nigel" wrote:
post your code for observation


here's the relevant code followed by a sample of the database. (all
the formatting and indentations were lost) . The area I'm interested
in improving are lines 51-75

1 Option Explicit
2 Sub BuildList()
3
4 Dim CustomerName As String, Addr As String
5 Dim i As Integer, j As Integer, k As Integer
6 Dim ProductMatrix(200, 2)
7 Dim Flag As Boolean
8
9 Sheets("Current").Select 'switch to master
10
11 Range("A1").Activate
12
13 CustomerName = BuildChartSet.GigList.Value
14
15 ' find the CustomerName selected
16 Cells. Find(What:=CustomerName, After:=ActiveCell,
Lookln:=xIFormulas, _
17 LookAt:=xIPart, SearchOrder:=xIByRows, SearchDirection:=xINext,_
18 MatchCase:=False, SearchFormat:=False).Activate
19
20 Addr = ActiveCell.Address 'create key that sorts on desired
column
21
22 ActiveCell.CurrentRegion.Sort Key1 :=Range(Addr),
Order1 :=xIAscending, Header:= _
23 xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xITopToBottom, _
24 DataOption 1 :=xISortTextAsNumbers
25
26 i = 1 ' initalize counters
27 j = 1
28 k = 1
29
30 Do Until ActiveCell = "" , count number of entries in column
31 ProductMatrix(k, 1) = Cells(k, 1) 'product name
32 ProductMatrix(k, 2) = Left(ActiveCell, 1) ' first character from
set code
33 ActiveCell.Offset(1, 0).Activate
34 k = k + 1
35 Loop
36
37 Workbooks.Add 'create new worksbook
38 Sheets("Sheet1").Select
39
40 For j = 1 To k 'write transfer array onto new worksheet
41 Cells(j, 1) = ProductMatrix(j, 1) ' product name
42 Cells(j, 2) = ProductMatrix(j, 2) ' group (1 ,2,3,Alternate,etc)
43 Nextj
44
45 j = 1
46 k = 1
47 Range("A1").Activate 'starting row of list
48
49 Flag = False ' set flag for when pointer reaches alpha group
50
51 Do Until ActiveCell = ""
52
53 If Cells(j, 2) = k Then I inset line with "group" and group
54 Selection.EntireRow.lnsert' number above each section
55 Selection. Font. Bold = True
56 ActiveCell(1, 1) = "Group" & k
57 ActiveCell.Offset(1, 0). Activate
58 k = k + 1
59 Else
60 If Flag = True Then GoTo jump 'bypass alpha
61 If Cells(j, 2) = "A" Then ' inset line with alpha above alpha
section
62 Selection. EntireRow. Insert
63 Selection.Font.Bold = True
64 ActiveCell( 1, 1) = "Alternate"
65 ActiveCell.Offset(1, 0).Activate
66 'after first product marked "alternate" is found, set flag to skip
future instances
67 Flag = True
68 End If
69 End If
70
71 j = j + 1 ' advance pointer
72
73 jump: ActiveCell.Offset(1, 0).Activate
74
75 Loop
76
77 Columns("B:B").Activate
78 Selection. Delete Shift:=xIToLeft 'delete column with X.YY
codes
79
80 End Sub

the database: (each ":" is a tab to align up under each column)

Product:Customer 1:Customer 2:Customer 3:Customer 4:Customer 5
product 1:2.04:A.06:A.05::
product 2:2.05::::
product 3:::2.04::
product 4:2.07:::3.04:4.02
product 5:2.14::A.06::
product 6:A.01::1.04::1.02
product 7:::::1.04
product 8:A.05:::A.02:A.03
product 9:1.06:A.01:4.02::
product 10::::1.01:2.01
product 11::1.04:::
product 12:::1.01::
product 13:1.02:2.06:3.03:2.01:2.04
product 14:1.03:2.07:3.04::
product 15::::3.10:A.01
product 16:A.04::::
product 17::::A.08:
product 18:2.06::::
product 19::::3.05:4.03
product 20::::3.02:4.01
product 21:::2.01::
product 22::2.01:1.06::
product 23::::3.01:3.02
product 24:1.04:2.11:4.01::
product 25:1.05:2.12:2.02:3.03:
product 26::2.03:::
product 27:A.03::::
product 28:::A.08::
product 29:::A.09::
product 30:::1.05:A.03:A.04
product 31:2.02:A.04:A.03::
product 32::1.03:2.05::
product 33::::A.04:
product 34:::3.02::
product 35:2.08:::A.05:
product 36::::1.03:2.02
product 37::::1.02:1.03
product 38::::1.04:
product 39:2.03:A.05:A.04:A.07:
product 40:::1.03::
product 41::1.01:1.02::
product 42::::A.09:
product 43::::A.10:1.01
product 44::1.02:::
product 45:::3.01::
product 46:1.01:2.05:1.07::
product 47::::A.01:A.02
product 48:::A.07::
product 49:::::1.05
product 50:1.08:2.02:::
product 51::2.04:::
product 52:A.02::::
product 53:::::
product 54::::1.05:2.03
product 55:2.01:A.03:A.02::
product 56::::2.03:3.01
product 57:1.07:A.02:A.01::
product 58:::::
product 59::::A.06:
product 60:::2.03::
product 61::::2.02:2.05