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