Info

Next i End Sub

Private Sub CommandButton3_Click() 1 Clear all regions For i = 0 To lbRegion.ListCount - 1 Me.lbRegion.Selected(i) = False Next i End Sub

Private Sub CommandButton4_Click() 1 Mark all regions For i = 0 To lbRegion.ListCount - 1 Me.lbRegion.Selected(i) = True Next i End Sub

Private Sub OKButton_Click()

Dim CRange As Range, IRange As Range, ORange As Range 1 Build a complex criteria that ANDS all choices together NextCCol = 10 NextTCol = 15

MyControl = "lbCust" MyColumn = 4 Case 2

MyControl = "lbProduct" MyColumn = 2 Case 3

MyControl = "lbRegion" MyColumn = 1 End Select NextRow = 2

1 Check to see what was selected.

For i = 0 To Me.Controls(MyControl).ListCount - 1

If Me.Controls(MyControl).Selected(i) = True Then Cells(NextRow, NextTCol).Value = _ Me.Controls(MyControl).List(i) NextRow = NextRow + 1 End If Next i

1 If anything was selected, build a new criteria formula If NextRow > 2 Then

' the reference to Row 2 must be relative in order to work MyFormula = "=NOT(ISNA(MATCH(RC" & MyColumn & ",R2C" & NextTCol &

":R" & NextRow - 1 & "C" & NextTCol & ",False)))" Cells(2, NextCCol).FormulaR1C1 = MyFormula NextTCol = NextTCol + 1 NextCCol = NextCCol + 1 End If Next j Unload Me

1 Figure 11.14 shows the worksheet at this point ' if we built any criteria, define the criteria range If NextCCol > 10 Then

Set CRange = Range(Cells(1, 10), Cells(2, NextCCol - 1)) Set IRange = Range("A1").CurrentRegion Set ORange = Cells(1, 20)

IRange.AdvancedFilter xlFilterCopy, CRange, ORange ' Clear out the criteria

Cells(1, 10).Resize(1, 10).EntireColumn.Clear End If

1 At this point, the matching records are in T1 End Sub

Private Sub UserForm_Initialize() Dim IRange As Range Dim ORange As Range

1 Find the size of today's dataset FinalRow = Cells(65536, 1).End(xlUp).Row NextCol = Cells(1, 255).End(xlToLeft).Column + 2

' Define the input range

Set IRange = Range("A1").Resize(FinalRow, NextCol - 2)

' Set up output range for Customer. Copy heading from D1 there Range("D1").Copy Destination:=Cells(1, NextCol) Set ORange = Cells(1, NextCol)

' Do the Advanced Filter to get unique list of customers IRange.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:="", _ CopyToRange:=ORange, Unique:=True

' Determine how many unique customers we have LastRow = Cells(65536, NextCol).End(xlUp).Row

' Sort the data

Cells(1, NextCol).Resize(LastRow, 1).Sort Key1:=Cells(1, NextCol), Order1:=xlAscending, Header:=xlYes

With Me.lbCust

FinalRow = Range("J65536").End(xlUp).Row

For Each cell In Cells(2, NextCol).Resize(LastRow - 1, 1)

.AddItem cell.Value Next cell End With

0 0

Post a comment