Database Manipulation - Collections & Arrays ?

[stuartgb100]

I've had much help on the Forum with helping a friend with his data.
This is now sorted into three columns (B-D)
The data consists of:
b: combined English/French string
c: English portion of the string
d: French portion of the string

It is basically a dictionary

This is currently 6700 rows in length, but he says more is on the way (strewth, friend is stretching it a bit now !).
However, I am learning something, so I wish to see this through.

He needs now to sort the records into various sub sections.
He will have to define these for me.

I'd like to get ahead of the game here, if I can.

A typical record set

[TABLE="width: 1265"]
<tbody>[TR]
[TD]wood bois m (in col B)
wood
bois m
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
I would like to be able to 'tag' this record set with 'C' for carpentry, 'M' for materials, etc.

If I place a 'C' in col E (same row as the record set), and similarly an 'M' in col F
could I then cycle through cols E and F and when a value is found, copy the row to a new sheet, such that all 'C'
items are in a new sheet, and all 'M' items similarly ?

There may well be more than just 'C' and 'M' options, so how do I allow for that probability please ?

Thanks.

 

[stuartgb100]

Ok., I have written some code.
Seems to work, but will be slow to run several thousand rows !

I'm sure I had help to do this before using Collections, and maybe arrays, but I cannot find the code.

Here's what I have so far:

[FONT=Calibri][SIZE=3][COLOR=#000000]Option Explicit[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]Sub SortDictionary()[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]Dim TagRng As Range, FirstRw As Long, LastRw As Long[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Dim DataRng As Range, C As Range, SheetName As String[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Dim DataSht As Worksheet, TargetRw As Long, CopyRng As Range[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]Application.ScreenUpdating = False[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Application.CutCopyMode = False[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]  With ActiveSheet[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Set DataSht = ActiveSheet[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    FirstRw = 1[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    LastRw = .Range("B65536").End(xlUp).Row[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Set DataRng =.Range("B1:B" & LastRw)   ‘rowsof data[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Set TagRng = .Range(“F1:M"& LastRw)   ‘cells that could containTags[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    For Each C In TagRng[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        If Not IsEmpty(C) Then   ‘there is a Tag in the cell[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            SheetName = "Tag- " & C.Value[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            If NotSheetExists(SheetName, ActiveWorkbook) = True Then[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]               ThisWorkbook.Sheets.Add(After:=Sheets(Sheets.Count)).Name = SheetName[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]                WithWorksheets(SheetName)[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]                    .Columns(1).ColumnWidth = 2[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]                   .Columns(2).ColumnWidth = 50[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]                   .Columns(3).ColumnWidth = 50[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]                   .Columns(4).ColumnWidth = 2[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]                   .Columns(5).ColumnWidth = 100[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]                    .Columns(6).ColumnWidth= 3[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]                End With[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            End If[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            WithThisWorkbook.Sheets(DataSht.Name)[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]                Set CopyRng =.Range("B" & C.Row, "E" & C.Row)   ‘the dataset[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]                CopyRng.Copy[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            End With[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            TargetRw =Worksheets(SheetName).Range("B65536").End(xlUp).Row + 1[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]           Worksheets(SheetName).Range("B" & TargetRw).PasteSpecial[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]           Worksheets(SheetName).Range("F" & TargetRw).Value = C.Value   ‘copy the Tag value[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        End If[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Next[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]  End With[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]Application.ScreenUpdating = True[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Application.CutCopyMode = True[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]End Sub[/COLOR][/SIZE][/FONT]


[FONT=Calibri][SIZE=3][COLOR=#000000]Function SheetExists(SheetName As String, _[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Optional InWorkbook AsWorkbook) As Boolean[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]'This is Chip Pearson's function.[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]'(In fact, it's copied from one of his posts):[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]Dim wb As Workbook[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]If InWorkbook Is Nothing Then[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Set wb = ActiveWorkbook[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Else[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Set wb = InWorkbook[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]End If[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]On Error Resume Next[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]SheetExists = CBool(Len((wb.Worksheets(SheetName).Name)))[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]On Error GoTo 0[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]End Function

Can anyone help me speed up the code, please ?

Thanks.
[/COLOR][/SIZE][/FONT]