Hello:

In my spreadsheet I have many members that i am designing. each member
has a name that starts with a "J". For example J1, J2, J3....... i
might do several checks on each member, therfore the marks will be
placed in one of the sheets named "QDSsheet" starting in cell "A3" as
follows:
I wont know how many checks per mark. meaning i might have 4 J1's 0R
100 J1's, and the same goes for other marks. right now my code is set
up ok using "FOR... NEXT" provided the marks are in numeric
sequential order( J1....., J2.....,J3,.....,J4,.....,it will recognize
how many J1 is there or how many J2 is there so it loops by increment
of one. I would like you to tell me how to write the code so that it
loops through all the marks regardless of the order and what the number
or string after the J as shown below. Thanks!

Marks
J1
J1
J1
J1
J10
J10
J11
J12
J12A
J18
J18
J18
J17A
J17A
J17A
J17B
J15C

written assuming the J's are in column 1.

Sub LoopJs()
Dim jlist As New Collection
Dim rng As Range, cnt As Long
Dim sAddr As String, s As String
Dim itm As Variant
Set rng = Columns(1).Find(What:="J*", _
After:=Range("A65536").End(xlUp)(2), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rng Is Nothing Then
sAddr = rng.Address
Do
On Error Resume Next
jlist.Add rng.Value, rng.Text
On Error GoTo 0
Set rng = Columns(1).FindNext(rng)
Loop While rng.Address < sAddr
s = ""
For Each itm In jlist
cnt = Application.CountIf(Columns(1), itm)
s = s & itm & ": " & cnt & vbNewLine
Next
MsgBox s
Else
MsgBox "No J's found"
End If
End Sub

Modify to fit your layout and achieve your required results.

--
Regards,
Tom Ogilvy


" wrote:


Hello:

In my spreadsheet I have many members that i am designing. each member
has a name that starts with a "J". For example J1, J2, J3....... i
might do several checks on each member, therfore the marks will be
placed in one of the sheets named "QDSsheet" starting in cell "A3" as
follows:
I wont know how many checks per mark. meaning i might have 4 J1's 0R
100 J1's, and the same goes for other marks. right now my code is set
up ok using "FOR... NEXT" provided the marks are in numeric
sequential order( J1....., J2.....,J3,.....,J4,.....,it will recognize
how many J1 is there or how many J2 is there so it loops by increment
of one. I would like you to tell me how to write the code so that it
loops through all the marks regardless of the order and what the number
or string after the J as shown below. Thanks!

Marks
J1
J1
J1
J1
J10
J10
J11
J12
J12A
J18
J18
J18
J17A
J17A
J17A
J17B
J15C

Thanks Tom for your quick reponse, I will try it and let you know.

hello Tom Ogilvy or any one that could help me fix the procedu

Attached is my code. as you can see i am determining the number of J
marks in coulmn which they all start at cell A3 in sheetQDS. the number
of marks =Nu, as you can see i am looping from 1 to Nu. but the problem
with this code, it works fine if all my marks are J1....J2....J3 so
that there is no gaps in the numbering system and the number after the
J is an integer. it does not work if i have J1A, OR J5C. how could i
fix it to do that regrdless whether there is a gap or not or wheteher
it is a J1 OR J1S? Thanks for any assitance!

'get the number of marks
lastrow = shtQDS.Range("A3").End(xlDown).Row
Set rng = shtQDS.Range("A3:A" & lastrow)
v = rng
On Error Resume Next
For M = LBound(v) To UBound(v)
nodupes.Add v(M, 1), CStr(v(M, 1))
Next
On Error GoTo 0
numUnique = nodupes.Count
If shtWOOD.Cells(1, 2).Value = "ALL" Then
'Nu = shtQDS.Range("BC1").Value
Nu = numUnique
End If
For Z = 1 To Nu Step 1
strMark = "J" & Z
Application.ScreenUpdating = False
'Error check
'If strMark = "" Then
' MsgBox "No mark chosen. Analysis cancelled."
'GoTo CancelAnalysis
'End If

'Clear old data
shtEM.Range("B2:B9").clearcontents
shtEM.Range("B10:C13").clearcontents
shtPA.Range("B33:AO44").clearcontents
shtPA.Range("B66:AO75").clearcontents
'shtSummary.Range("A3:H1000").clearcontents
shtResults.Range("A3:AR65536").clearcontents
shtNPCJ.Range("B10:C13").clearcontents
intResultRow = 3

'Set initial values
i = 3
intLines = 0
intLoadCase = 1
boolCancel = False

Application.ScreenUpdating = False
Worksheets.Add after:=Worksheets(Worksheets.Count)
NewSheet = ActiveSheet.Name
With Worksheets(NewSheet)
.Move after:=Worksheets(Worksheets.Count)
.Name = strMark
.Activate
Columns("A:A").ColumnWidth = 51.14
Columns("B:AR").Select
Selection.ColumnWidth = 13
ActiveWindow.Zoom = 75
End With

'Find out how many load cases we're dealing with
Mark:
Do
If shtQDS.Cells(i, 1).Value = strMark Then
If shtQDS.Cells(i, 4).Value intLoadCases Then intLoadCases =
shtQDS.Cells(i, 4).Value
End If
i = i + 1
Loop Until IsEmpty(shtQDS.Cells(i, 1))

i = 3

FindNext:

'Find valid row
Do
If shtQDS.Cells(i, 1).Value = strMark And shtQDS.Cells(i, 4).Value
= intLoadCase Then
GoTo GetValues
Else
i = i + 1
End If

Loop Until IsEmpty(shtQDS.Cells(i, 1))

'After no more valid rows for that load case, run optimization routine
Optimize

'Determine if any more load cases exist
If intLoadCase < intLoadCases Then
intLoadCase = intLoadCase + 1
i = 3
GoTo FindNext
End If

For R = 2 + Z To Nu + 3 Step 1
Sheets("Summary").Cells(R, 1).Value = strMark
Sheets("Summary").Cells(R, 2).Value = intQty
Sheets("Summary").Cells(R, 3).Value = dblLength
Sheets("Summary").Cells(R, 4).Value = intETCA
Sheets("Summary").Cells(R, 5).Value = intEBCA
Sheets("Summary").Cells(R, 6).Value =
Sheets(strMark).Range("D2").Value
Sheets("Summary").Cells(R, 7).Value =
Sheets(strMark).Range("E2").Value


Exit For

Next
Next

The J Values are stored in Nodupes, so instead of building the J value by
doing

"J" & Z

just use the value in the collection

Instead of

For Z = 1 To Nu Step 1
strMark = "J" & Z


Dim itm as Variant

i = 0
for each itm in Nodupes
i = i + 1 ' in case you need to use i in your loop
strMark = itm


' code to process

Next itm


--
Regards,
Tom Ogilvy
wrote in message
oups.com...
hello Tom Ogilvy or any one that could help me fix the procedu

Attached is my code. as you can see i am determining the number of J
marks in coulmn which they all start at cell A3 in sheetQDS. the number
of marks =Nu, as you can see i am looping from 1 to Nu. but the problem
with this code, it works fine if all my marks are J1....J2....J3 so
that there is no gaps in the numbering system and the number after the
J is an integer. it does not work if i have J1A, OR J5C. how could i
fix it to do that regrdless whether there is a gap or not or wheteher
it is a J1 OR J1S? Thanks for any assitance!

'get the number of marks
lastrow = shtQDS.Range("A3").End(xlDown).Row
Set rng = shtQDS.Range("A3:A" & lastrow)
v = rng
On Error Resume Next
For M = LBound(v) To UBound(v)
nodupes.Add v(M, 1), CStr(v(M, 1))
Next
On Error GoTo 0
numUnique = nodupes.Count
If shtWOOD.Cells(1, 2).Value = "ALL" Then
'Nu = shtQDS.Range("BC1").Value
Nu = numUnique
End If
For Z = 1 To Nu Step 1
strMark = "J" & Z
Application.ScreenUpdating = False
'Error check
'If strMark = "" Then
' MsgBox "No mark chosen. Analysis cancelled."
'GoTo CancelAnalysis
'End If

'Clear old data
shtEM.Range("B2:B9").clearcontents
shtEM.Range("B10:C13").clearcontents
shtPA.Range("B33:AO44").clearcontents
shtPA.Range("B66:AO75").clearcontents
'shtSummary.Range("A3:H1000").clearcontents
shtResults.Range("A3:AR65536").clearcontents
shtNPCJ.Range("B10:C13").clearcontents
intResultRow = 3

'Set initial values
i = 3
intLines = 0
intLoadCase = 1
boolCancel = False

Application.ScreenUpdating = False
Worksheets.Add after:=Worksheets(Worksheets.Count)
NewSheet = ActiveSheet.Name
With Worksheets(NewSheet)
.Move after:=Worksheets(Worksheets.Count)
.Name = strMark
.Activate
Columns("A:A").ColumnWidth = 51.14
Columns("B:AR").Select
Selection.ColumnWidth = 13
ActiveWindow.Zoom = 75
End With

'Find out how many load cases we're dealing with
Mark:
Do
If shtQDS.Cells(i, 1).Value = strMark Then
If shtQDS.Cells(i, 4).Value intLoadCases Then intLoadCases =
shtQDS.Cells(i, 4).Value
End If
i = i + 1
Loop Until IsEmpty(shtQDS.Cells(i, 1))

i = 3

FindNext:

'Find valid row
Do
If shtQDS.Cells(i, 1).Value = strMark And shtQDS.Cells(i, 4).Value
= intLoadCase Then
GoTo GetValues
Else
i = i + 1
End If

Loop Until IsEmpty(shtQDS.Cells(i, 1))

'After no more valid rows for that load case, run optimization routine
Optimize

'Determine if any more load cases exist
If intLoadCase < intLoadCases Then
intLoadCase = intLoadCase + 1
i = 3
GoTo FindNext
End If

For R = 2 + Z To Nu + 3 Step 1
Sheets("Summary").Cells(R, 1).Value = strMark
Sheets("Summary").Cells(R, 2).Value = intQty
Sheets("Summary").Cells(R, 3).Value = dblLength
Sheets("Summary").Cells(R, 4).Value = intETCA
Sheets("Summary").Cells(R, 5).Value = intEBCA
Sheets("Summary").Cells(R, 6).Value =
Sheets(strMark).Range("D2").Value
Sheets("Summary").Cells(R, 7).Value =
Sheets(strMark).Range("E2").Value


Exit For

Next
Next