Good morning JLGWhiz or anyone else....
I was looking through the posts to see if you were able to post the
corrected macro before you left for the day, since you said you would try in
the evening or today. Unfortunetly I couldn't find any of the posts from our
conversation. What happened to them? Just in case here is the macro you
gave me.

Private Sub ListBox1_Click()

Dim ws As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim lr4, lc4, mCnt, cnt As Long

lr4 = Sheets("last four").Cells(Rows.count, 2).End(xlUp).Row
lc4 = Sheets("last four").UsedRange.Columns.count + 1

Set ws = Sheets("test Database")
Set rng = ws.Range("B26:AD2500")
Sheets("test Database").Range("A25").Value = ListBox1.Value
For i = 0 To UserForm6.ListBox1.ListCount - 1
If UserForm6.ListBox1.Selected(i) Then
With Application
.ScreenUpdating = False
.EnableEvents = False
End With

ws.AutoFilterMode = False
rng.AutoFilter field:=1, Criteria1:="=" & ws.Range("A25").Value
ws.AutoFilter.Range.Copy
With Sheets("last four")
..Range("B2500").End(xlUp).Offset(1, 0).PasteSpecial _
Paste:=xlValues, operation:=xlNone, _
skipblanks:=False, Transpose:=False

ws.AutoFilterMode = False
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
Next

myvar4 = UserForm6.ListBox1.Selected(i)
mCnt = Application.CountIf(.Range("B72:B" & lr4), myvar4)

If mCnt = 4 Then
mCnt = 4
End If
cnt = 1
For i = lr4 To 72 Step -1
If .Cells(i, 2) = myvar4 Then
If cnt <= 4 Then
.Range("A9:Z12").ClearContents
Select Case mCnt

Case Is = 1
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B9").PateSpecial Paste:=xlPasteValues

Case Is = 2
If x = "" Then x = 10
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B&x").PateSpecial Paste:=xlPasteValues
x = x - 1

Case Is = 3
If x = "" Then x = 11
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B&x").PateSpecial Paste:=xlPasteValues
x = x - 1

Case Is = 4
If x = "" Then x = 12
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B&x").PateSpecial Paste:=xlPasteValues
x = x - 1

End Select
cnt = cnt + 1
End If
End If
Next
End With

Range("S14").Select
'sheets("last four").protect "1dickson"

End Sub

Eric

Hi Eric, I was having problems with the autofilter, but I have just about
worked that out. I am fine tuning the process and will post back to this
posting as soon as I get it fixed. Should not be more than an hour or so.

"Eric" wrote:

Good morning JLGWhiz or anyone else....
I was looking through the posts to see if you were able to post the
corrected macro before you left for the day, since you said you would try in
the evening or today. Unfortunetly I couldn't find any of the posts from our
conversation. What happened to them? Just in case here is the macro you
gave me.

Private Sub ListBox1_Click()

Dim ws As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim lr4, lc4, mCnt, cnt As Long

lr4 = Sheets("last four").Cells(Rows.count, 2).End(xlUp).Row
lc4 = Sheets("last four").UsedRange.Columns.count + 1

Set ws = Sheets("test Database")
Set rng = ws.Range("B26:AD2500")
Sheets("test Database").Range("A25").Value = ListBox1.Value
For i = 0 To UserForm6.ListBox1.ListCount - 1
If UserForm6.ListBox1.Selected(i) Then
With Application
.ScreenUpdating = False
.EnableEvents = False
End With

ws.AutoFilterMode = False
rng.AutoFilter field:=1, Criteria1:="=" & ws.Range("A25").Value
ws.AutoFilter.Range.Copy
With Sheets("last four")
.Range("B2500").End(xlUp).Offset(1, 0).PasteSpecial _
Paste:=xlValues, operation:=xlNone, _
skipblanks:=False, Transpose:=False

ws.AutoFilterMode = False
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
Next

myvar4 = UserForm6.ListBox1.Selected(i)
mCnt = Application.CountIf(.Range("B72:B" & lr4), myvar4)

If mCnt = 4 Then
mCnt = 4
End If
cnt = 1
For i = lr4 To 72 Step -1
If .Cells(i, 2) = myvar4 Then
If cnt <= 4 Then
.Range("A9:Z12").ClearContents
Select Case mCnt

Case Is = 1
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B9").PateSpecial Paste:=xlPasteValues

Case Is = 2
If x = "" Then x = 10
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B&x").PateSpecial Paste:=xlPasteValues
x = x - 1

Case Is = 3
If x = "" Then x = 11
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B&x").PateSpecial Paste:=xlPasteValues
x = x - 1

Case Is = 4
If x = "" Then x = 12
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B&x").PateSpecial Paste:=xlPasteValues
x = x - 1

End Select
cnt = cnt + 1
End If
End If
Next
End With

Range("S14").Select
'sheets("last four").protect "1dickson"

End Sub

Eric

I think this will do what you want more efficiently than the
way you had it set up. It puts the main code in a standard
code module so the autofilter works properly. It calls the
UserForm6 so you can select the mix type from ListBox1.
As soon as you select the mix type the UserForm closes and
the code returns to the standard module for filtering and
copying to sheet "last four" where the last four or less
tests will then be moved to rows 9-12. I noticed that
you will continue to build a long list below row 71 of
sheet "last four". If you don't want to do that, you
can put a line in at the bottom of the procedure to
clearContents for Range("B71:AD" & lr4). Try this on
a copy first and Let me know if there are questions.

Copy and Paste these. Don't try to type them.

Put this code behind your UserForm6 in its code window:

Private Sub UserForm_Initialize()
lr = Sheets("test Database").Range("B" & Rows.Count).End(xlUp).Row
sRng = Sheets("test Database").Range("B26:B" & lr).Address
ListBox1.RowSource = "'test Database'!" & sRng
End Sub


This is the new code for your ListBox1. Delete what is there now
and replace with this:

Private Sub ListBox1_Click()
Sheets("Sheet1").Range("A25") = ListBox1.Value
Unload UserForm1
End Sub


The following code goes in the standar code module:

Sub last4()
Dim ws As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim lr4, lc4, mCnt, cnt As Long
lr = Sheets("test Database").Cells(Rows.Count, 2).End(xlUp).Row
lr4 = Sheets("last four").Cells(Rows.Count, 2).End(xlUp).Row
Set ws = Worksheets("test Database")
Set rng = ws.Range("B26:AD" & lr)
UserForm6.Show
myVar4 = Sheets("test Database").Range("A25")
If Sheets("test Database).Range("A25") "" Then
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
ws.AutoFilterMode = False
cRng = Sheets("test Database").Range("A25").Value
rng.AutoFilter Field:=1, Criteria1:=cRng, VisibleDropDown:=False
ws.AutoFilter.Range.Copy
Sheets("last four").Range("B" & lr4 + 1).PasteSpecial Paste:=xlValues
ws.AutoFilterMode = False
Application.CutCopyMode = False
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
With Sheets("last four")
lr4 = Sheets("last four").Cells(Rows.Count, 2).End(xlUp).Row
lc4 = Sheets("last four").UsedRange.Columns.Count + 1
mCnt = Application.CountIf(.Range("B72:B" & lr4), myVar4)
Range("A9:Z12").ClearContents
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
If mCnt = 4 Then
mCnt = 4
End If
cnt = 1
For i = lr4 To 72 Step -1
If .Cells(i, 2) = myVar4 Then
If cnt <= 4 Then
Select Case mCnt
Case Is = 1
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B9").PasteSpecial Paste:=xlPasteValues
Case Is = 2
If x = "" Then x = 10
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B" & x).PasteSpecial Paste:=xlPasteValues
x = x - 1
Case Is = 3
If x = "" Then x = 11
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B" & x).PasteSpecial Paste:=xlPasteValues
x = x - 1
Case Is = 4
If x = "" Then x = 12
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B" & x).PasteSpecial Paste:=xlPasteValues
x = x - 1
End Select
cnt = cnt + 1
End If
End If
Next
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End With
Application.CutCopyMode = False
End Sub

"Eric" wrote:

Good morning JLGWhiz or anyone else....
I was looking through the posts to see if you were able to post the
corrected macro before you left for the day, since you said you would try in
the evening or today. Unfortunetly I couldn't find any of the posts from our
conversation. What happened to them? Just in case here is the macro you
gave me.

Private Sub ListBox1_Click()

Dim ws As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim lr4, lc4, mCnt, cnt As Long

lr4 = Sheets("last four").Cells(Rows.count, 2).End(xlUp).Row
lc4 = Sheets("last four").UsedRange.Columns.count + 1

Set ws = Sheets("test Database")
Set rng = ws.Range("B26:AD2500")
Sheets("test Database").Range("A25").Value = ListBox1.Value
For i = 0 To UserForm6.ListBox1.ListCount - 1
If UserForm6.ListBox1.Selected(i) Then
With Application
.ScreenUpdating = False
.EnableEvents = False
End With

ws.AutoFilterMode = False
rng.AutoFilter field:=1, Criteria1:="=" & ws.Range("A25").Value
ws.AutoFilter.Range.Copy
With Sheets("last four")
.Range("B2500").End(xlUp).Offset(1, 0).PasteSpecial _
Paste:=xlValues, operation:=xlNone, _
skipblanks:=False, Transpose:=False

ws.AutoFilterMode = False
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
Next

myvar4 = UserForm6.ListBox1.Selected(i)
mCnt = Application.CountIf(.Range("B72:B" & lr4), myvar4)

If mCnt = 4 Then
mCnt = 4
End If
cnt = 1
For i = lr4 To 72 Step -1
If .Cells(i, 2) = myvar4 Then
If cnt <= 4 Then
.Range("A9:Z12").ClearContents
Select Case mCnt

Case Is = 1
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B9").PateSpecial Paste:=xlPasteValues

Case Is = 2
If x = "" Then x = 10
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B&x").PateSpecial Paste:=xlPasteValues
x = x - 1

Case Is = 3
If x = "" Then x = 11
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B&x").PateSpecial Paste:=xlPasteValues
x = x - 1

Case Is = 4
If x = "" Then x = 12
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B&x").PateSpecial Paste:=xlPasteValues
x = x - 1

End Select
cnt = cnt + 1
End If
End If
Next
End With

Range("S14").Select
'sheets("last four").protect "1dickson"

End Sub

Eric

Hello again,

It's my turn to be confused.....
The first part you said to put behind userform6.....Where is that?

If I click on the userform6 the listbox macro shows up.

The standard macro is the main macro that takes you to the userform6 and
runs the listbox and whatever else is in there correct?

If this is so, how do you want this information put in?
1) standard macro Sub last4()
2) userform6 Private Sub ListBox1_Click()
3) paste Private Sub UserForm_Initialize() under neath the listbox 1 macro

Can you tell me what is going to happen with all these?

1) am I going to copy all the selected mix types from test database to the
last four sheet?

Eric
"JLGWhiz" wrote:

I think this will do what you want more efficiently than the
way you had it set up. It puts the main code in a standard
code module so the autofilter works properly. It calls the
UserForm6 so you can select the mix type from ListBox1.
As soon as you select the mix type the UserForm closes and
the code returns to the standard module for filtering and
copying to sheet "last four" where the last four or less
tests will then be moved to rows 9-12. I noticed that
you will continue to build a long list below row 71 of
sheet "last four". If you don't want to do that, you
can put a line in at the bottom of the procedure to
clearContents for Range("B71:AD" & lr4). Try this on
a copy first and Let me know if there are questions.

Copy and Paste these. Don't try to type them.

Put this code behind your UserForm6 in its code window:

Private Sub UserForm_Initialize()
lr = Sheets("test Database").Range("B" & Rows.Count).End(xlUp).Row
sRng = Sheets("test Database").Range("B26:B" & lr).Address
ListBox1.RowSource = "'test Database'!" & sRng
End Sub


This is the new code for your ListBox1. Delete what is there now
and replace with this:

Private Sub ListBox1_Click()
Sheets("Sheet1").Range("A25") = ListBox1.Value
Unload UserForm1
End Sub


The following code goes in the standar code module:

Sub last4()
Dim ws As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim lr4, lc4, mCnt, cnt As Long
lr = Sheets("test Database").Cells(Rows.Count, 2).End(xlUp).Row
lr4 = Sheets("last four").Cells(Rows.Count, 2).End(xlUp).Row
Set ws = Worksheets("test Database")
Set rng = ws.Range("B26:AD" & lr)
UserForm6.Show
myVar4 = Sheets("test Database").Range("A25")
If Sheets("test Database).Range("A25") "" Then
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
ws.AutoFilterMode = False
cRng = Sheets("test Database").Range("A25").Value
rng.AutoFilter Field:=1, Criteria1:=cRng, VisibleDropDown:=False
ws.AutoFilter.Range.Copy
Sheets("last four").Range("B" & lr4 + 1).PasteSpecial Paste:=xlValues
ws.AutoFilterMode = False
Application.CutCopyMode = False
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
With Sheets("last four")
lr4 = Sheets("last four").Cells(Rows.Count, 2).End(xlUp).Row
lc4 = Sheets("last four").UsedRange.Columns.Count + 1
mCnt = Application.CountIf(.Range("B72:B" & lr4), myVar4)
Range("A9:Z12").ClearContents
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
If mCnt = 4 Then
mCnt = 4
End If
cnt = 1
For i = lr4 To 72 Step -1
If .Cells(i, 2) = myVar4 Then
If cnt <= 4 Then
Select Case mCnt
Case Is = 1
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B9").PasteSpecial Paste:=xlPasteValues
Case Is = 2
If x = "" Then x = 10
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B" & x).PasteSpecial Paste:=xlPasteValues
x = x - 1
Case Is = 3
If x = "" Then x = 11
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B" & x).PasteSpecial Paste:=xlPasteValues
x = x - 1
Case Is = 4
If x = "" Then x = 12
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B" & x).PasteSpecial Paste:=xlPasteValues
x = x - 1
End Select
cnt = cnt + 1
End If
End If
Next
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End With
Application.CutCopyMode = False
End Sub

"Eric" wrote:

Good morning JLGWhiz or anyone else....
I was looking through the posts to see if you were able to post the
corrected macro before you left for the day, since you said you would try in
the evening or today. Unfortunetly I couldn't find any of the posts from our
conversation. What happened to them? Just in case here is the macro you
gave me.

Private Sub ListBox1_Click()

Dim ws As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim lr4, lc4, mCnt, cnt As Long

lr4 = Sheets("last four").Cells(Rows.count, 2).End(xlUp).Row
lc4 = Sheets("last four").UsedRange.Columns.count + 1

Set ws = Sheets("test Database")
Set rng = ws.Range("B26:AD2500")
Sheets("test Database").Range("A25").Value = ListBox1.Value
For i = 0 To UserForm6.ListBox1.ListCount - 1
If UserForm6.ListBox1.Selected(i) Then
With Application
.ScreenUpdating = False
.EnableEvents = False
End With

ws.AutoFilterMode = False
rng.AutoFilter field:=1, Criteria1:="=" & ws.Range("A25").Value
ws.AutoFilter.Range.Copy
With Sheets("last four")
.Range("B2500").End(xlUp).Offset(1, 0).PasteSpecial _
Paste:=xlValues, operation:=xlNone, _
skipblanks:=False, Transpose:=False

ws.AutoFilterMode = False
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
Next

myvar4 = UserForm6.ListBox1.Selected(i)
mCnt = Application.CountIf(.Range("B72:B" & lr4), myvar4)

If mCnt = 4 Then
mCnt = 4
End If
cnt = 1
For i = lr4 To 72 Step -1
If .Cells(i, 2) = myvar4 Then
If cnt <= 4 Then
.Range("A9:Z12").ClearContents
Select Case mCnt

Case Is = 1
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B9").PateSpecial Paste:=xlPasteValues

Case Is = 2
If x = "" Then x = 10
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B&x").PateSpecial Paste:=xlPasteValues
x = x - 1

Case Is = 3
If x = "" Then x = 11
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B&x").PateSpecial Paste:=xlPasteValues
x = x - 1

Case Is = 4
If x = "" Then x = 12
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B&x").PateSpecial Paste:=xlPasteValues
x = x - 1

End Select
cnt = cnt + 1
End If
End If
Next
End With

Range("S14").Select
'sheets("last four").protect "1dickson"

End Sub

Eric

I am trying to use the macro and this is how I have set it up.....

Sub last4() then userform6 macro on userform6

Private Sub ListBox1_Click() Then with no end sub

Private Sub UserForm_Initialize() with out the sub (so listbox1 and
initialize are together in one macro.

1) I am not getting anything to show up in the list box
2) I am copying over column C form the test database sheet (see previous
post)

Eric






"Eric" wrote:

Hello again,

It's my turn to be confused.....
The first part you said to put behind userform6.....Where is that?

If I click on the userform6 the listbox macro shows up.

The standard macro is the main macro that takes you to the userform6 and
runs the listbox and whatever else is in there correct?

If this is so, how do you want this information put in?
1) standard macro Sub last4()
2) userform6 Private Sub ListBox1_Click()
3) paste Private Sub UserForm_Initialize() under neath the listbox 1 macro

Can you tell me what is going to happen with all these?

1) am I going to copy all the selected mix types from test database to the
last four sheet?

Eric
"JLGWhiz" wrote:

I think this will do what you want more efficiently than the
way you had it set up. It puts the main code in a standard
code module so the autofilter works properly. It calls the
UserForm6 so you can select the mix type from ListBox1.
As soon as you select the mix type the UserForm closes and
the code returns to the standard module for filtering and
copying to sheet "last four" where the last four or less
tests will then be moved to rows 9-12. I noticed that
you will continue to build a long list below row 71 of
sheet "last four". If you don't want to do that, you
can put a line in at the bottom of the procedure to
clearContents for Range("B71:AD" & lr4). Try this on
a copy first and Let me know if there are questions.

Copy and Paste these. Don't try to type them.

Put this code behind your UserForm6 in its code window:

Private Sub UserForm_Initialize()
lr = Sheets("test Database").Range("B" & Rows.Count).End(xlUp).Row
sRng = Sheets("test Database").Range("B26:B" & lr).Address
ListBox1.RowSource = "'test Database'!" & sRng
End Sub


This is the new code for your ListBox1. Delete what is there now
and replace with this:

Private Sub ListBox1_Click()
Sheets("Sheet1").Range("A25") = ListBox1.Value
Unload UserForm1
End Sub


The following code goes in the standar code module:

Sub last4()
Dim ws As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim lr4, lc4, mCnt, cnt As Long
lr = Sheets("test Database").Cells(Rows.Count, 2).End(xlUp).Row
lr4 = Sheets("last four").Cells(Rows.Count, 2).End(xlUp).Row
Set ws = Worksheets("test Database")
Set rng = ws.Range("B26:AD" & lr)
UserForm6.Show
myVar4 = Sheets("test Database").Range("A25")
If Sheets("test Database).Range("A25") "" Then
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
ws.AutoFilterMode = False
cRng = Sheets("test Database").Range("A25").Value
rng.AutoFilter Field:=1, Criteria1:=cRng, VisibleDropDown:=False
ws.AutoFilter.Range.Copy
Sheets("last four").Range("B" & lr4 + 1).PasteSpecial Paste:=xlValues
ws.AutoFilterMode = False
Application.CutCopyMode = False
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
With Sheets("last four")
lr4 = Sheets("last four").Cells(Rows.Count, 2).End(xlUp).Row
lc4 = Sheets("last four").UsedRange.Columns.Count + 1
mCnt = Application.CountIf(.Range("B72:B" & lr4), myVar4)
Range("A9:Z12").ClearContents
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
If mCnt = 4 Then
mCnt = 4
End If
cnt = 1
For i = lr4 To 72 Step -1
If .Cells(i, 2) = myVar4 Then
If cnt <= 4 Then
Select Case mCnt
Case Is = 1
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B9").PasteSpecial Paste:=xlPasteValues
Case Is = 2
If x = "" Then x = 10
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B" & x).PasteSpecial Paste:=xlPasteValues
x = x - 1
Case Is = 3
If x = "" Then x = 11
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B" & x).PasteSpecial Paste:=xlPasteValues
x = x - 1
Case Is = 4
If x = "" Then x = 12
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B" & x).PasteSpecial Paste:=xlPasteValues
x = x - 1
End Select
cnt = cnt + 1
End If
End If
Next
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End With
Application.CutCopyMode = False
End Sub

"Eric" wrote:

Good morning JLGWhiz or anyone else....
I was looking through the posts to see if you were able to post the
corrected macro before you left for the day, since you said you would try in
the evening or today. Unfortunetly I couldn't find any of the posts from our
conversation. What happened to them? Just in case here is the macro you
gave me.

Private Sub ListBox1_Click()

Dim ws As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim lr4, lc4, mCnt, cnt As Long

lr4 = Sheets("last four").Cells(Rows.count, 2).End(xlUp).Row
lc4 = Sheets("last four").UsedRange.Columns.count + 1

Set ws = Sheets("test Database")
Set rng = ws.Range("B26:AD2500")
Sheets("test Database").Range("A25").Value = ListBox1.Value
For i = 0 To UserForm6.ListBox1.ListCount - 1
If UserForm6.ListBox1.Selected(i) Then
With Application
.ScreenUpdating = False
.EnableEvents = False
End With

ws.AutoFilterMode = False
rng.AutoFilter field:=1, Criteria1:="=" & ws.Range("A25").Value
ws.AutoFilter.Range.Copy
With Sheets("last four")
.Range("B2500").End(xlUp).Offset(1, 0).PasteSpecial _
Paste:=xlValues, operation:=xlNone, _
skipblanks:=False, Transpose:=False

ws.AutoFilterMode = False
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
Next

myvar4 = UserForm6.ListBox1.Selected(i)
mCnt = Application.CountIf(.Range("B72:B" & lr4), myvar4)

If mCnt = 4 Then
mCnt = 4
End If
cnt = 1
For i = lr4 To 72 Step -1
If .Cells(i, 2) = myvar4 Then
If cnt <= 4 Then
.Range("A9:Z12").ClearContents
Select Case mCnt

Case Is = 1
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B9").PateSpecial Paste:=xlPasteValues

Case Is = 2
If x = "" Then x = 10
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B&x").PateSpecial Paste:=xlPasteValues
x = x - 1

Case Is = 3
If x = "" Then x = 11
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B&x").PateSpecial Paste:=xlPasteValues
x = x - 1

Case Is = 4
If x = "" Then x = 12
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B&x").PateSpecial Paste:=xlPasteValues
x = x - 1

End Select
cnt = cnt + 1
End If
End If
Next
End With

Range("S14").Select
'sheets("last four").protect "1dickson"

End Sub

Eric

Here is how they should be loaded.

I assume you renamed the main procedure from
usf4() to last4().

Sub last4() <<<This is the big one
Should be in Module1 code window. If you don't have
a module1, click insertmodule. This one does not
go on the form. It will be called when needed and
will run from the standard code module.

Private Sub ListBox1_Click() <<<<The new one below
Should be in the UserForm code window
and it will call last4() when clicked and wild
unload the UserForm.

Private Sub UserForm_Initialize
Should be in the UserForm Code window
This loads your list box so you can select a
mix type.

These are separate subs, not to be merged.

Modifications to previous code.

1. Delete the previous one and use this one.

Private Sub ListBox1_Click()
Sheets("Sheet1").Range("A25") = ListBox1.Value
Unload UserForm1
last4
End Sub

2. In the big procedure, last4, delete the line:

UserForm6.Show

All subs must have an End Sub statement.

You already have that command somewhere in your
original setup, I assume, although I never saw it
anywhere in the code we were working with.

Now, if properly loaded you should be able to click
listbox1 and get the results you want. If not, let
me know.

"Eric" wrote:

I am trying to use the macro and this is how I have set it up.....

Sub last4() then userform6 macro on userform6

Private Sub ListBox1_Click() Then with no end sub

Private Sub UserForm_Initialize() with out the sub (so listbox1 and
initialize are together in one macro.

1) I am not getting anything to show up in the list box
2) I am copying over column C form the test database sheet (see previous
post)

Eric






"Eric" wrote:

Hello again,

It's my turn to be confused.....
The first part you said to put behind userform6.....Where is that?

If I click on the userform6 the listbox macro shows up.

The standard macro is the main macro that takes you to the userform6 and
runs the listbox and whatever else is in there correct?

If this is so, how do you want this information put in?
1) standard macro Sub last4()
2) userform6 Private Sub ListBox1_Click()
3) paste Private Sub UserForm_Initialize() under neath the listbox 1 macro

Can you tell me what is going to happen with all these?

1) am I going to copy all the selected mix types from test database to the
last four sheet?

Eric
"JLGWhiz" wrote:

I think this will do what you want more efficiently than the
way you had it set up. It puts the main code in a standard
code module so the autofilter works properly. It calls the
UserForm6 so you can select the mix type from ListBox1.
As soon as you select the mix type the UserForm closes and
the code returns to the standard module for filtering and
copying to sheet "last four" where the last four or less
tests will then be moved to rows 9-12. I noticed that
you will continue to build a long list below row 71 of
sheet "last four". If you don't want to do that, you
can put a line in at the bottom of the procedure to
clearContents for Range("B71:AD" & lr4). Try this on
a copy first and Let me know if there are questions.

Copy and Paste these. Don't try to type them.

Put this code behind your UserForm6 in its code window:

Private Sub UserForm_Initialize()
lr = Sheets("test Database").Range("B" & Rows.Count).End(xlUp).Row
sRng = Sheets("test Database").Range("B26:B" & lr).Address
ListBox1.RowSource = "'test Database'!" & sRng
End Sub


This is the new code for your ListBox1. Delete what is there now
and replace with this:

Private Sub ListBox1_Click()
Sheets("Sheet1").Range("A25") = ListBox1.Value
Unload UserForm1
End Sub


The following code goes in the standar code module:

Sub last4()
Dim ws As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim lr4, lc4, mCnt, cnt As Long
lr = Sheets("test Database").Cells(Rows.Count, 2).End(xlUp).Row
lr4 = Sheets("last four").Cells(Rows.Count, 2).End(xlUp).Row
Set ws = Worksheets("test Database")
Set rng = ws.Range("B26:AD" & lr)
UserForm6.Show
myVar4 = Sheets("test Database").Range("A25")
If Sheets("test Database).Range("A25") "" Then
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
ws.AutoFilterMode = False
cRng = Sheets("test Database").Range("A25").Value
rng.AutoFilter Field:=1, Criteria1:=cRng, VisibleDropDown:=False
ws.AutoFilter.Range.Copy
Sheets("last four").Range("B" & lr4 + 1).PasteSpecial Paste:=xlValues
ws.AutoFilterMode = False
Application.CutCopyMode = False
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
With Sheets("last four")
lr4 = Sheets("last four").Cells(Rows.Count, 2).End(xlUp).Row
lc4 = Sheets("last four").UsedRange.Columns.Count + 1
mCnt = Application.CountIf(.Range("B72:B" & lr4), myVar4)
Range("A9:Z12").ClearContents
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
If mCnt = 4 Then
mCnt = 4
End If
cnt = 1
For i = lr4 To 72 Step -1
If .Cells(i, 2) = myVar4 Then
If cnt <= 4 Then
Select Case mCnt
Case Is = 1
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B9").PasteSpecial Paste:=xlPasteValues
Case Is = 2
If x = "" Then x = 10
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B" & x).PasteSpecial Paste:=xlPasteValues
x = x - 1
Case Is = 3
If x = "" Then x = 11
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B" & x).PasteSpecial Paste:=xlPasteValues
x = x - 1
Case Is = 4
If x = "" Then x = 12
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B" & x).PasteSpecial Paste:=xlPasteValues
x = x - 1
End Select
cnt = cnt + 1
End If
End If
Next
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End With
Application.CutCopyMode = False
End Sub

"Eric" wrote:

Good morning JLGWhiz or anyone else....
I was looking through the posts to see if you were able to post the
corrected macro before you left for the day, since you said you would try in
the evening or today. Unfortunetly I couldn't find any of the posts from our
conversation. What happened to them? Just in case here is the macro you
gave me.

Private Sub ListBox1_Click()

Dim ws As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim lr4, lc4, mCnt, cnt As Long

lr4 = Sheets("last four").Cells(Rows.count, 2).End(xlUp).Row
lc4 = Sheets("last four").UsedRange.Columns.count + 1

Set ws = Sheets("test Database")
Set rng = ws.Range("B26:AD2500")
Sheets("test Database").Range("A25").Value = ListBox1.Value
For i = 0 To UserForm6.ListBox1.ListCount - 1
If UserForm6.ListBox1.Selected(i) Then
With Application
.ScreenUpdating = False
.EnableEvents = False
End With

ws.AutoFilterMode = False
rng.AutoFilter field:=1, Criteria1:="=" & ws.Range("A25").Value
ws.AutoFilter.Range.Copy
With Sheets("last four")
.Range("B2500").End(xlUp).Offset(1, 0).PasteSpecial _
Paste:=xlValues, operation:=xlNone, _
skipblanks:=False, Transpose:=False

ws.AutoFilterMode = False
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
Next

myvar4 = UserForm6.ListBox1.Selected(i)
mCnt = Application.CountIf(.Range("B72:B" & lr4), myvar4)

If mCnt = 4 Then
mCnt = 4
End If
cnt = 1
For i = lr4 To 72 Step -1
If .Cells(i, 2) = myvar4 Then
If cnt <= 4 Then
.Range("A9:Z12").ClearContents
Select Case mCnt

Case Is = 1
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B9").PateSpecial Paste:=xlPasteValues

Case Is = 2
If x = "" Then x = 10
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B&x").PateSpecial Paste:=xlPasteValues
x = x - 1

Case Is = 3
If x = "" Then x = 11
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B&x").PateSpecial Paste:=xlPasteValues
x = x - 1

Case Is = 4
If x = "" Then x = 12
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B&x").PateSpecial Paste:=xlPasteValues
x = x - 1

End Select
cnt = cnt + 1
End If
End If
Next
End With

Range("S14").Select
'sheets("last four").protect "1dickson"

End Sub

Eric

There is a typo in the click procedure. It should be UserForm6, Not
UserForm1. I try to change all these back when I post, but my senility
sets in and I forget.

"Eric" wrote:

I am trying to use the macro and this is how I have set it up.....

Sub last4() then userform6 macro on userform6

Private Sub ListBox1_Click() Then with no end sub

Private Sub UserForm_Initialize() with out the sub (so listbox1 and
initialize are together in one macro.

1) I am not getting anything to show up in the list box
2) I am copying over column C form the test database sheet (see previous
post)

Eric






"Eric" wrote:

Hello again,

It's my turn to be confused.....
The first part you said to put behind userform6.....Where is that?

If I click on the userform6 the listbox macro shows up.

The standard macro is the main macro that takes you to the userform6 and
runs the listbox and whatever else is in there correct?

If this is so, how do you want this information put in?
1) standard macro Sub last4()
2) userform6 Private Sub ListBox1_Click()
3) paste Private Sub UserForm_Initialize() under neath the listbox 1 macro

Can you tell me what is going to happen with all these?

1) am I going to copy all the selected mix types from test database to the
last four sheet?

Eric
"JLGWhiz" wrote:

I think this will do what you want more efficiently than the
way you had it set up. It puts the main code in a standard
code module so the autofilter works properly. It calls the
UserForm6 so you can select the mix type from ListBox1.
As soon as you select the mix type the UserForm closes and
the code returns to the standard module for filtering and
copying to sheet "last four" where the last four or less
tests will then be moved to rows 9-12. I noticed that
you will continue to build a long list below row 71 of
sheet "last four". If you don't want to do that, you
can put a line in at the bottom of the procedure to
clearContents for Range("B71:AD" & lr4). Try this on
a copy first and Let me know if there are questions.

Copy and Paste these. Don't try to type them.

Put this code behind your UserForm6 in its code window:

Private Sub UserForm_Initialize()
lr = Sheets("test Database").Range("B" & Rows.Count).End(xlUp).Row
sRng = Sheets("test Database").Range("B26:B" & lr).Address
ListBox1.RowSource = "'test Database'!" & sRng
End Sub


This is the new code for your ListBox1. Delete what is there now
and replace with this:

Private Sub ListBox1_Click()
Sheets("Sheet1").Range("A25") = ListBox1.Value
Unload UserForm1
End Sub


The following code goes in the standar code module:

Sub last4()
Dim ws As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim lr4, lc4, mCnt, cnt As Long
lr = Sheets("test Database").Cells(Rows.Count, 2).End(xlUp).Row
lr4 = Sheets("last four").Cells(Rows.Count, 2).End(xlUp).Row
Set ws = Worksheets("test Database")
Set rng = ws.Range("B26:AD" & lr)
UserForm6.Show
myVar4 = Sheets("test Database").Range("A25")
If Sheets("test Database).Range("A25") "" Then
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
ws.AutoFilterMode = False
cRng = Sheets("test Database").Range("A25").Value
rng.AutoFilter Field:=1, Criteria1:=cRng, VisibleDropDown:=False
ws.AutoFilter.Range.Copy
Sheets("last four").Range("B" & lr4 + 1).PasteSpecial Paste:=xlValues
ws.AutoFilterMode = False
Application.CutCopyMode = False
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
With Sheets("last four")
lr4 = Sheets("last four").Cells(Rows.Count, 2).End(xlUp).Row
lc4 = Sheets("last four").UsedRange.Columns.Count + 1
mCnt = Application.CountIf(.Range("B72:B" & lr4), myVar4)
Range("A9:Z12").ClearContents
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
If mCnt = 4 Then
mCnt = 4
End If
cnt = 1
For i = lr4 To 72 Step -1
If .Cells(i, 2) = myVar4 Then
If cnt <= 4 Then
Select Case mCnt
Case Is = 1
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B9").PasteSpecial Paste:=xlPasteValues
Case Is = 2
If x = "" Then x = 10
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B" & x).PasteSpecial Paste:=xlPasteValues
x = x - 1
Case Is = 3
If x = "" Then x = 11
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B" & x).PasteSpecial Paste:=xlPasteValues
x = x - 1
Case Is = 4
If x = "" Then x = 12
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B" & x).PasteSpecial Paste:=xlPasteValues
x = x - 1
End Select
cnt = cnt + 1
End If
End If
Next
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End With
Application.CutCopyMode = False
End Sub

"Eric" wrote:

Good morning JLGWhiz or anyone else....
I was looking through the posts to see if you were able to post the
corrected macro before you left for the day, since you said you would try in
the evening or today. Unfortunetly I couldn't find any of the posts from our
conversation. What happened to them? Just in case here is the macro you
gave me.

Private Sub ListBox1_Click()

Dim ws As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim lr4, lc4, mCnt, cnt As Long

lr4 = Sheets("last four").Cells(Rows.count, 2).End(xlUp).Row
lc4 = Sheets("last four").UsedRange.Columns.count + 1

Set ws = Sheets("test Database")
Set rng = ws.Range("B26:AD2500")
Sheets("test Database").Range("A25").Value = ListBox1.Value
For i = 0 To UserForm6.ListBox1.ListCount - 1
If UserForm6.ListBox1.Selected(i) Then
With Application
.ScreenUpdating = False
.EnableEvents = False
End With

ws.AutoFilterMode = False
rng.AutoFilter field:=1, Criteria1:="=" & ws.Range("A25").Value
ws.AutoFilter.Range.Copy
With Sheets("last four")
.Range("B2500").End(xlUp).Offset(1, 0).PasteSpecial _
Paste:=xlValues, operation:=xlNone, _
skipblanks:=False, Transpose:=False

ws.AutoFilterMode = False
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
Next

myvar4 = UserForm6.ListBox1.Selected(i)
mCnt = Application.CountIf(.Range("B72:B" & lr4), myvar4)

If mCnt = 4 Then
mCnt = 4
End If
cnt = 1
For i = lr4 To 72 Step -1
If .Cells(i, 2) = myvar4 Then
If cnt <= 4 Then
.Range("A9:Z12").ClearContents
Select Case mCnt

Case Is = 1
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B9").PateSpecial Paste:=xlPasteValues

Case Is = 2
If x = "" Then x = 10
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B&x").PateSpecial Paste:=xlPasteValues
x = x - 1

Case Is = 3
If x = "" Then x = 11
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B&x").PateSpecial Paste:=xlPasteValues
x = x - 1

Case Is = 4
If x = "" Then x = 12
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B&x").PateSpecial Paste:=xlPasteValues
x = x - 1

End Select
cnt = cnt + 1
End If
End If
Next
End With

Range("S14").Select
'sheets("last four").protect "1dickson"

End Sub

Eric

I have installed everything just like you said. Copy and pasted the macros....

Module 1 has the following
Sub last4()
Dim ws As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim lr4, lc4, mCnt, cnt As Long
lr = Sheets("test Database").Cells(Rows.count, 2).End(xlUp).Row
lr4 = Sheets("last four").Cells(Rows.count, 2).End(xlUp).Row
Set ws = Worksheets("test Database")
Set rng = ws.Range("B26:AD" & lr)

myVar4 = Sheets("test Database").Range("A25")
If Sheets("test Database").Range("A25") "" Then
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
ws.AutoFilterMode = False
cRng = Sheets("test Database").Range("A25").Value
rng.AutoFilter Field:=1, Criteria1:=cRng, VisibleDropDown:=False
ws.AutoFilter.Range.Copy
Sheets("last four").Range("B" & lr4 + 1).PasteSpecial Paste:=xlValues
ws.AutoFilterMode = False
Application.CutCopyMode = False
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
With Sheets("last four")
lr4 = Sheets("last four").Cells(Rows.count, 2).End(xlUp).Row
lc4 = Sheets("last four").UsedRange.Columns.count + 1
mCnt = Application.CountIf(.Range("B72:B" & lr4), myVar4)
Range("A9:Z12").ClearContents
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
If mCnt = 4 Then
mCnt = 4
End If
cnt = 1
For i = lr4 To 72 Step -1
If .Cells(i, 2) = myVar4 Then
If cnt <= 4 Then
Select Case mCnt
Case Is = 1
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B9").PasteSpecial Paste:=xlPasteValues
Case Is = 2
If x = "" Then x = 10
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B" & x).PasteSpecial Paste:=xlPasteValues
x = x - 1
Case Is = 3
If x = "" Then x = 11
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B" & x).PasteSpecial Paste:=xlPasteValues
x = x - 1
Case Is = 4
If x = "" Then x = 12
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B" & x).PasteSpecial Paste:=xlPasteValues
x = x - 1
End Select
cnt = cnt + 1
End If
End If
Next
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End With
Application.CutCopyMode = False
End Sub

Userform6 has the following;

Private Sub ListBox1_Click()
Sheets("sheet1").Range("A25") = ListBox1.Value
Unload UserForm6
last4
End Sub

Private Sub UserForm_Initialize()
lr = Sheets("test Database").Range("B" & Rows.count).End(xlUp).Row
sRng = Sheets("test Database").Range("B26:B" & lr).Address
ListBox1.RowSource = "'test Database'!" & sRng
End Sub

1) When I go to Tools~~macros~~ and click on last4() I copy all the tests
for mix type 4069 from sheets("test database") to sheets("last four").

2) I don't get the listbox1 to show up and ask what mix I want to copy.

3) Column C which has the test numbers goes from test #1 (row27) to test
#1974 (row 2000). Consiquently, the last four (4) tests are blank. For this
purpose I deleted everything in column C past the eigth test (row 35).

4) Now when I start the macro only the tests copy over but I still don't
get anything in Rows 9 through 12 on sheets("last four")

Eric



"JLGWhiz" wrote:

There is a typo in the click procedure. It should be UserForm6, Not
UserForm1. I try to change all these back when I post, but my senility
sets in and I forget.

"Eric" wrote:

I am trying to use the macro and this is how I have set it up.....

Sub last4() then userform6 macro on userform6

Private Sub ListBox1_Click() Then with no end sub

Private Sub UserForm_Initialize() with out the sub (so listbox1 and
initialize are together in one macro.

1) I am not getting anything to show up in the list box
2) I am copying over column C form the test database sheet (see previous
post)

Eric






"Eric" wrote:

Hello again,

It's my turn to be confused.....
The first part you said to put behind userform6.....Where is that?

If I click on the userform6 the listbox macro shows up.

The standard macro is the main macro that takes you to the userform6 and
runs the listbox and whatever else is in there correct?

If this is so, how do you want this information put in?
1) standard macro Sub last4()
2) userform6 Private Sub ListBox1_Click()
3) paste Private Sub UserForm_Initialize() under neath the listbox 1 macro

Can you tell me what is going to happen with all these?

1) am I going to copy all the selected mix types from test database to the
last four sheet?

Eric
"JLGWhiz" wrote:

I think this will do what you want more efficiently than the
way you had it set up. It puts the main code in a standard
code module so the autofilter works properly. It calls the
UserForm6 so you can select the mix type from ListBox1.
As soon as you select the mix type the UserForm closes and
the code returns to the standard module for filtering and
copying to sheet "last four" where the last four or less
tests will then be moved to rows 9-12. I noticed that
you will continue to build a long list below row 71 of
sheet "last four". If you don't want to do that, you
can put a line in at the bottom of the procedure to
clearContents for Range("B71:AD" & lr4). Try this on
a copy first and Let me know if there are questions.

Copy and Paste these. Don't try to type them.

Put this code behind your UserForm6 in its code window:

Private Sub UserForm_Initialize()
lr = Sheets("test Database").Range("B" & Rows.Count).End(xlUp).Row
sRng = Sheets("test Database").Range("B26:B" & lr).Address
ListBox1.RowSource = "'test Database'!" & sRng
End Sub


This is the new code for your ListBox1. Delete what is there now
and replace with this:

Private Sub ListBox1_Click()
Sheets("Sheet1").Range("A25") = ListBox1.Value
Unload UserForm1
End Sub


The following code goes in the standar code module:

Sub last4()
Dim ws As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim lr4, lc4, mCnt, cnt As Long
lr = Sheets("test Database").Cells(Rows.Count, 2).End(xlUp).Row
lr4 = Sheets("last four").Cells(Rows.Count, 2).End(xlUp).Row
Set ws = Worksheets("test Database")
Set rng = ws.Range("B26:AD" & lr)
UserForm6.Show
myVar4 = Sheets("test Database").Range("A25")
If Sheets("test Database).Range("A25") "" Then
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
ws.AutoFilterMode = False
cRng = Sheets("test Database").Range("A25").Value
rng.AutoFilter Field:=1, Criteria1:=cRng, VisibleDropDown:=False
ws.AutoFilter.Range.Copy
Sheets("last four").Range("B" & lr4 + 1).PasteSpecial Paste:=xlValues
ws.AutoFilterMode = False
Application.CutCopyMode = False
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
With Sheets("last four")
lr4 = Sheets("last four").Cells(Rows.Count, 2).End(xlUp).Row
lc4 = Sheets("last four").UsedRange.Columns.Count + 1
mCnt = Application.CountIf(.Range("B72:B" & lr4), myVar4)
Range("A9:Z12").ClearContents
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
If mCnt = 4 Then
mCnt = 4
End If
cnt = 1
For i = lr4 To 72 Step -1
If .Cells(i, 2) = myVar4 Then
If cnt <= 4 Then
Select Case mCnt
Case Is = 1
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B9").PasteSpecial Paste:=xlPasteValues
Case Is = 2
If x = "" Then x = 10
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B" & x).PasteSpecial Paste:=xlPasteValues
x = x - 1
Case Is = 3
If x = "" Then x = 11
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B" & x).PasteSpecial Paste:=xlPasteValues
x = x - 1
Case Is = 4
If x = "" Then x = 12
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B" & x).PasteSpecial Paste:=xlPasteValues
x = x - 1
End Select
cnt = cnt + 1
End If
End If
Next
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End With
Application.CutCopyMode = False
End Sub

"Eric" wrote:

Good morning JLGWhiz or anyone else....
I was looking through the posts to see if you were able to post the
corrected macro before you left for the day, since you said you would try in
the evening or today. Unfortunetly I couldn't find any of the posts from our
conversation. What happened to them? Just in case here is the macro you
gave me.

Private Sub ListBox1_Click()

Dim ws As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim lr4, lc4, mCnt, cnt As Long

lr4 = Sheets("last four").Cells(Rows.count, 2).End(xlUp).Row
lc4 = Sheets("last four").UsedRange.Columns.count + 1

Set ws = Sheets("test Database")
Set rng = ws.Range("B26:AD2500")
Sheets("test Database").Range("A25").Value = ListBox1.Value
For i = 0 To UserForm6.ListBox1.ListCount - 1
If UserForm6.ListBox1.Selected(i) Then
With Application
.ScreenUpdating = False
.EnableEvents = False
End With

ws.AutoFilterMode = False
rng.AutoFilter field:=1, Criteria1:="=" & ws.Range("A25").Value
ws.AutoFilter.Range.Copy
With Sheets("last four")
.Range("B2500").End(xlUp).Offset(1, 0).PasteSpecial _
Paste:=xlValues, operation:=xlNone, _
skipblanks:=False, Transpose:=False

ws.AutoFilterMode = False
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
Next

myvar4 = UserForm6.ListBox1.Selected(i)
mCnt = Application.CountIf(.Range("B72:B" & lr4), myvar4)

If mCnt = 4 Then
mCnt = 4
End If
cnt = 1
For i = lr4 To 72 Step -1
If .Cells(i, 2) = myvar4 Then
If cnt <= 4 Then
.Range("A9:Z12").ClearContents
Select Case mCnt

Case Is = 1
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B9").PateSpecial Paste:=xlPasteValues

Case Is = 2
If x = "" Then x = 10
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B&x").PateSpecial Paste:=xlPasteValues
x = x - 1

Case Is = 3
If x = "" Then x = 11
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B&x").PateSpecial Paste:=xlPasteValues
x = x - 1

Case Is = 4
If x = "" Then x = 12
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B&x").PateSpecial Paste:=xlPasteValues
x = x - 1

End Select
cnt = cnt + 1
End If
End If
Next
End With

Range("S14").Select
'sheets("last four").protect "1dickson"

End Sub

Eric

Your Q, my A.

1) When I go to Tools~~macros~~ and click on last4() I copy
all the tests for mix type 4069 from sheets("test database")
to sheets("last four").

I don't know how you activated UserForm6 before. I thought you
would use the same method. If you activate UserForm six it
will allow you to select a mix type and will automatically run
the last4 macro.


2) I don't get the listbox1 to show up and ask what mix I want
to copy.

See answer to 1 above. If, repeat, If you don't have another
way to do it, then do the following. Copy and paste this
snippet into Module one:

Sub startLast4()
UserForm6.Show
End Sub

Then you can assign a keyboard key to start it by clicking
ToolsMacroOptions click on startLast4 and enter a keyboard key
in lower case that you want to use to run the program.


3) Column C which has the test numbers goes from test #1 (row27)
to test #1974 (row 2000). Consiquently, the last four (4) tests
are blank. For this purpose I deleted everything in column C
past the eigth test (row 35).

I have no idea what you are talking about here.


4) Now when I start the macro only the tests copy over but I
still don't get anything in Rows 9 through 12 on
sheets("last four")

You did not get anything in rows 9 thru 12 because Range("A25")
on Sheets("test Database") did not have anything in it. You will
need to get UserForm6 to show so you can click listbox1 and then
everything should work. A25 on the test Database tells the code
what to find and copy to last four and it also is used to tell
it how many tests to copy from the bottom of last four to Rows
9 - 12. So if you didn't put something in A25, it don't work
right. Clicking ListBox1 automatically loads A25.

New subject. Change this from: Range("A9:Z12").ClearContents
To: Range("A9:AD12").ClearContents.

It is another one I missed changing to meet your sheet layout.

I think we are about to whip this thing. Make a new posting
for additional problems.

"Eric" wrote:

I have installed everything just like you said. Copy and pasted the macros....

Module 1 has the following
Sub last4()
Dim ws As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim lr4, lc4, mCnt, cnt As Long
lr = Sheets("test Database").Cells(Rows.count, 2).End(xlUp).Row
lr4 = Sheets("last four").Cells(Rows.count, 2).End(xlUp).Row
Set ws = Worksheets("test Database")
Set rng = ws.Range("B26:AD" & lr)

myVar4 = Sheets("test Database").Range("A25")
If Sheets("test Database").Range("A25") "" Then
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
ws.AutoFilterMode = False
cRng = Sheets("test Database").Range("A25").Value
rng.AutoFilter Field:=1, Criteria1:=cRng, VisibleDropDown:=False
ws.AutoFilter.Range.Copy
Sheets("last four").Range("B" & lr4 + 1).PasteSpecial Paste:=xlValues
ws.AutoFilterMode = False
Application.CutCopyMode = False
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
With Sheets("last four")
lr4 = Sheets("last four").Cells(Rows.count, 2).End(xlUp).Row
lc4 = Sheets("last four").UsedRange.Columns.count + 1
mCnt = Application.CountIf(.Range("B72:B" & lr4), myVar4)
Range("A9:Z12").ClearContents
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
If mCnt = 4 Then
mCnt = 4
End If
cnt = 1
For i = lr4 To 72 Step -1
If .Cells(i, 2) = myVar4 Then
If cnt <= 4 Then
Select Case mCnt
Case Is = 1
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B9").PasteSpecial Paste:=xlPasteValues
Case Is = 2
If x = "" Then x = 10
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B" & x).PasteSpecial Paste:=xlPasteValues
x = x - 1
Case Is = 3
If x = "" Then x = 11
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B" & x).PasteSpecial Paste:=xlPasteValues
x = x - 1
Case Is = 4
If x = "" Then x = 12
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B" & x).PasteSpecial Paste:=xlPasteValues
x = x - 1
End Select
cnt = cnt + 1
End If
End If
Next
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End With
Application.CutCopyMode = False
End Sub

Userform6 has the following;

Private Sub ListBox1_Click()
Sheets("sheet1").Range("A25") = ListBox1.Value
Unload UserForm6
last4
End Sub

Private Sub UserForm_Initialize()
lr = Sheets("test Database").Range("B" & Rows.count).End(xlUp).Row
sRng = Sheets("test Database").Range("B26:B" & lr).Address
ListBox1.RowSource = "'test Database'!" & sRng
End Sub

1) When I go to Tools~~macros~~ and click on last4() I copy all the tests
for mix type 4069 from sheets("test database") to sheets("last four").

2) I don't get the listbox1 to show up and ask what mix I want to copy.

3) Column C which has the test numbers goes from test #1 (row27) to test
#1974 (row 2000). Consiquently, the last four (4) tests are blank. For this
purpose I deleted everything in column C past the eigth test (row 35).

4) Now when I start the macro only the tests copy over but I still don't
get anything in Rows 9 through 12 on sheets("last four")

Eric



"JLGWhiz" wrote:

There is a typo in the click procedure. It should be UserForm6, Not
UserForm1. I try to change all these back when I post, but my senility
sets in and I forget.

"Eric" wrote:

I am trying to use the macro and this is how I have set it up.....

Sub last4() then userform6 macro on userform6

Private Sub ListBox1_Click() Then with no end sub

Private Sub UserForm_Initialize() with out the sub (so listbox1 and
initialize are together in one macro.

1) I am not getting anything to show up in the list box
2) I am copying over column C form the test database sheet (see previous
post)

Eric






"Eric" wrote:

Hello again,

It's my turn to be confused.....
The first part you said to put behind userform6.....Where is that?

If I click on the userform6 the listbox macro shows up.

The standard macro is the main macro that takes you to the userform6 and
runs the listbox and whatever else is in there correct?

If this is so, how do you want this information put in?
1) standard macro Sub last4()
2) userform6 Private Sub ListBox1_Click()
3) paste Private Sub UserForm_Initialize() under neath the listbox 1 macro

Can you tell me what is going to happen with all these?

1) am I going to copy all the selected mix types from test database to the
last four sheet?

Eric
"JLGWhiz" wrote:

I think this will do what you want more efficiently than the
way you had it set up. It puts the main code in a standard
code module so the autofilter works properly. It calls the
UserForm6 so you can select the mix type from ListBox1.
As soon as you select the mix type the UserForm closes and
the code returns to the standard module for filtering and
copying to sheet "last four" where the last four or less
tests will then be moved to rows 9-12. I noticed that
you will continue to build a long list below row 71 of
sheet "last four". If you don't want to do that, you
can put a line in at the bottom of the procedure to
clearContents for Range("B71:AD" & lr4). Try this on
a copy first and Let me know if there are questions.

Copy and Paste these. Don't try to type them.

Put this code behind your UserForm6 in its code window:

Private Sub UserForm_Initialize()
lr = Sheets("test Database").Range("B" & Rows.Count).End(xlUp).Row
sRng = Sheets("test Database").Range("B26:B" & lr).Address
ListBox1.RowSource = "'test Database'!" & sRng
End Sub


This is the new code for your ListBox1. Delete what is there now
and replace with this:

Private Sub ListBox1_Click()
Sheets("Sheet1").Range("A25") = ListBox1.Value
Unload UserForm1
End Sub


The following code goes in the standar code module:

Sub last4()
Dim ws As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim lr4, lc4, mCnt, cnt As Long
lr = Sheets("test Database").Cells(Rows.Count, 2).End(xlUp).Row
lr4 = Sheets("last four").Cells(Rows.Count, 2).End(xlUp).Row
Set ws = Worksheets("test Database")
Set rng = ws.Range("B26:AD" & lr)
UserForm6.Show
myVar4 = Sheets("test Database").Range("A25")
If Sheets("test Database).Range("A25") "" Then
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
ws.AutoFilterMode = False
cRng = Sheets("test Database").Range("A25").Value
rng.AutoFilter Field:=1, Criteria1:=cRng, VisibleDropDown:=False
ws.AutoFilter.Range.Copy
Sheets("last four").Range("B" & lr4 + 1).PasteSpecial Paste:=xlValues
ws.AutoFilterMode = False
Application.CutCopyMode = False
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
With Sheets("last four")
lr4 = Sheets("last four").Cells(Rows.Count, 2).End(xlUp).Row
lc4 = Sheets("last four").UsedRange.Columns.Count + 1
mCnt = Application.CountIf(.Range("B72:B" & lr4), myVar4)
Range("A9:Z12").ClearContents
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
If mCnt = 4 Then
mCnt = 4
End If
cnt = 1
For i = lr4 To 72 Step -1
If .Cells(i, 2) = myVar4 Then
If cnt <= 4 Then
Select Case mCnt
Case Is = 1
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B9").PasteSpecial Paste:=xlPasteValues
Case Is = 2
If x = "" Then x = 10
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B" & x).PasteSpecial Paste:=xlPasteValues
x = x - 1
Case Is = 3
If x = "" Then x = 11
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B" & x).PasteSpecial Paste:=xlPasteValues
x = x - 1
Case Is = 4
If x = "" Then x = 12
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B" & x).PasteSpecial Paste:=xlPasteValues
x = x - 1
End Select
cnt = cnt + 1
End If
End If
Next
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End With
Application.CutCopyMode = False
End Sub

"Eric" wrote:

Good morning JLGWhiz or anyone else....
I was looking through the posts to see if you were able to post the
corrected macro before you left for the day, since you said you would try in
the evening or today. Unfortunetly I couldn't find any of the posts from our
conversation. What happened to them? Just in case here is the macro you
gave me.

Private Sub ListBox1_Click()

Dim ws As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim lr4, lc4, mCnt, cnt As Long

lr4 = Sheets("last four").Cells(Rows.count, 2).End(xlUp).Row
lc4 = Sheets("last four").UsedRange.Columns.count + 1

Set ws = Sheets("test Database")
Set rng = ws.Range("B26:AD2500")
Sheets("test Database").Range("A25").Value = ListBox1.Value
For i = 0 To UserForm6.ListBox1.ListCount - 1
If UserForm6.ListBox1.Selected(i) Then
With Application
.ScreenUpdating = False