Nigel, I'm somewhat confused by the information you posted.
What is "Empty". Is that another constant or variable you have declared?
Typically, working with a range of cells on a worksheet, these snippets are
effective ways of doing it:
Dim myListRange As Range
Dim anyListEntry As Range
Set myListRange = ThisWorkbook.Worksheets("sheet name"). _
Range("CL1:CL2000")
'clear them all in one instruction
myListRange.ClearContents ' clear contents but not formatting
or
myListRange.ClearAll ' wipes out contents, formulas, formatting, etc.
It leaves myListRange empty, and available to be referenced in the same code
segment later on if necessary.
I'm confused about what value is in "check" or if you mean to pick it up
from a value in a cell on the sheet somewhere.
In your first routine, RunCheck(), it is going to probably jump out of the
sub before going all the way from 1 to 20: Your first test seems to set that
up. By using
Dim CL(1 to 20)
you have declared an array with 20 empty 'cells' or elements.
So, the first time thru the loop:
If CL(i) = Empty Then ' what is "Empty" but it is probably going to be
empty!
CL(i) = check ' fine, first time thru CL(1) gets set to 'check'
Exit Sub ' and you jump out of the loop and even out of the sub
End If
Each time you re-enter the routine, CL(1 to 20) are cleared of their
previous contents, so you never get beyond element 1!
If I were working in code and had one column with many entries and wanted to
just extract individual entries from it, one way to do that would be with
code like this. This assumes that the source list is in column A, and we
want to build the list of individual entries in column I. This code contains
some stuff your particular situation may not actually need, but I've included
it to kind of handle all situations, including putting the list of unique
entries on a separate worksheet, and with Const declarations that you can
change to adapt it to your situation.
Sub BuildUniqueEntryList()
'this routine will work through
'a list to identify unique entries
'in it and place those unique entries
'into another column
'The unique list may be on the same
'sheet or on another, depending on
'the definitions of the sheet names
'
Const sourceSheetName = "Sheet1"
Const sourceColumnID = "A" ' change as required
Const firstSourceRowUsed = 1 ' change as required
'next may be same name as sourceSheetName
'or different if the unique list is to
'appear on a different sheet
Const destSheetName = "Sheet2"
Const destColumnID = "I" ' change as required
Const destFirstRowToUse = 1 ' change as required
Dim sourceWS As Worksheet
Dim sourceListRange As Range
Dim anySourceEntry As Range
Dim destWS As Worksheet
Dim destList As Range
Dim anyDestEntry As Range
Dim anyRowPointer As Long
Dim matchedFlag As Boolean
Set sourceWS = Worksheets(sourceSheetName)
'do we have any work to do at all?
If sourceWS.Range(sourceColumnID & Rows.Count). _
End(xlUp).Row < firstSourceRowUsed Then
'nothing to do, just quit
Set sourceWS = Nothing
Exit Sub
End If
Set sourceListRange = sourceWS.Range(sourceColumnID & _
firstSourceRowUsed & ":" & _
sourceWS.Range(sourceColumnID & Rows.Count).End(xlUp).Address)
Set destWS = Worksheets(destSheetName)
'clear out any previous entries
'in the unique list area
anyRowPointer = destWS.Range(destColumnID & Rows.Count).End(xlUp).Row
If anyRowPointer < destFirstRowToUse Then
anyRowPointer = destFirstRowToUse
End If
destWS.Range(destColumnID & destFirstRowToUse & ":" _
& destColumnID & anyRowPointer).Clear
'initialize destList
Set destList = destWS.Range(destColumnID & destFirstRowToUse _
& ":" & destColumnID & anyRowPointer)
'examine each entry in the source list and compare
'it to entries in the unique list and if it is not
'found in the unique list, add it to the unique list
For Each anySourceEntry In sourceListRange
If Not IsEmpty(anySourceEntry) Then
matchedFlag = False ' initialize/reset
For Each anyDestEntry In destList
If anySourceEntry = anyDestEntry Then
matchedFlag = True
Exit For
End If
Next ' end of anyDestEntry loop
If Not matchedFlag Then
'this is a new unique entry
'place it at the end of the
'destList and redefine destList range
destWS.Range(destColumnID & Rows.Count).End(xlUp). _
Offset(1, 0) = anySourceEntry
'redefine destList to include the new entry
Set destList = destWS.Range(destColumnID & _
destFirstRowToUse & ":" & destWS.Range(destColumnID & _
Rows.Count).End(xlUp).Address)
End If
End If ' end of test for empty cell
Next ' end of anySourceEntry loop
'all finished, do cleanup
Set sourceListRange = Nothing
Set sourceWS = Nothing
Set destList = Nothing
Set destWS = Nothing
End Sub
For the code you posted, first declare the array CL(1 to 20) up in the same
area where you declared 'check'. It needs to be visible to all Subs in the
module also. Then remove the Dim CL(1 To 20) in Start() and in RunCheck().
As for the FilCliChart() you might try this (with the change to use CL(1 to
20) having been made:
Sub FilClIChart()
Dim LoopPointer As Integer
'in this case LBound(CL) = 1 and UBound(CL)=20
'automatically adapts if you change size of the array
Range("I5").Select
Application.ScreenUpdating=False
For LoopPointer = LBound(CL) to UBound(CL)
'activecell is I5
ActiveCell.Offset(LoopPointer-1,0) = CL(LoopPointer)
Next ' end of LoopPointer
End Sub
