-
Here's an example of how to change it. (Untested!!) Post a new example of your sheet maybe?
Cheers,
dr
[vba]
Sub ShowStuff()
Dim i As Long
Dim j As Long
Dim m As Long
'change to 4*4 from 3*4)
'Dim stuff(12)
Dim stuff(16)
Dim countr As Long
Dim oldrng As String
Dim namelist As String
Dim repeatlist As String
'screen
Application.ScreenUpdating = False
'set time as 30 seconds
' Change to 00:30:00 for 30 minutes
dTime = Now + TimeValue("00:00:30")
'set up to run again
Application.OnTime dTime, "ShowStuff"
'init counter
countr = 0
'get where we are
oldrng = ActiveCell.Address
'get stuff from rows 25 to 28. Old:
'For i = 25 To 28
'get stuff from Cols A(1) to C(3). Old:
'For j= 1 to 3
'CHANGE TO E11 TO H14
'
' CHANGE ROWS TO 11 TO 14 (4 rows not 3). New:
For i = 11 To 14
' CHANGE COLS TO E(5) to H(8) (4 cols not 3) New:
For j = 5 To 8
If Sheets(1).Cells(i, j) <> "analysis" Then
stuff(countr) = Sheets(1).Cells(i, j)
countr = countr + 1
End If
Next j
Next i
'build Message of students
namelist = stuff(0)
For i = 1 To UBound(stuff)
If stuff(i) <> "" Then
namelist = namelist & ", " & stuff(i)
End If
Next i
'display message box with "Stuff"
If namelist <> "" Then
m = MsgBox(namelist, , Title:="High Degree")
End If
'Copy student list
With Sheets(1)
If .Range("A99") = 2 Then
'put new data in 120
.Range("A25:C28").Copy
.Range("A120").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'compare 60 data, build list of repeats
For i = 100 To 103
For j = 1 To 3
If .Cells(i, j) <> "analysis" Then
If .Cells(i, j) = .Cells(i + 20, j) Then
If repeatlist = "" Then
repeatlist = .Cells(i, j)
Else
repeatlist = repeatlist & ", " & .Cells(i, j)
End If
End If
End If
Next j
Next i
'then move old data down one
.Range("A110:C113").Copy .Range("A100")
.Range("A120:C123").Copy .Range("A110")
ElseIf .Range("A99") = 1 Then
'first time (30)
.Range("A99") = 2
'put data in 110
.Range("A25:C28").Copy
.Range("A110").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
Application.CutCopyMode = False
End With
'display message box with "Repeats"
If repeatlist <> "" Then
m = MsgBox(repeatlist, , Title:="Repeated")
End If
'go home
Range(oldrng).Select
'screen
Application.ScreenUpdating = True
End Sub
[/vba]
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules