How to find the most common pair and triplet numbers?
Hi Paul,
(1) No, you won't need to select or activate the Input sheet. You usually
can work with a worksheet or range without selecting it. You can try
something like this:
With Worksheets("Input")
Set rng = .Range("B3:G3").End(xlDown)
End With
(2) Yes, you can validate if rng has no data. But since you're starting
with B3:G3, rng will never be equal to Nothing. What you can do is count
numeric values and if you get anything greater than 0 then it means you have
some data to work with. Something like this:
If Application.WorksheetFunction.Count(rng) 0 Then
'do something
End If
(3) In the code that I gave, c is a range variable that I used to loop
through the individual cells in the data range, lRow is a Long variable that
I used to keep track of the next available row in the "Results" worksheet and
lRow2 is also a Long variable that I used to determine the row number of a
pair or triplet that already exists in the Results worksheet. If the call to
the Match worksheetfunction does not result in error, then it means lRow2
would have the row number in Results for the current pair or triplet being
tested.
(4) In the code "If c.Column <= 5", 5 means column E. Because in my
example, the data is in columns A to F, then I can only have a pair for
values in columns A to E. If the cell is in column F (i.e., column=6) then,
the code should not do anything. In your case, since you're doing it for
data in columns B to G, you'll want to change the 5 to 6 for pairs and use 5
instead of 4 for triplets.
--
Hope that helps.
Vergel Adriano
"Paul Black" wrote:
Hi Vergel Adriano, thanks for the reply.
Please ignore my previous post. I did some calculations and came to
the conclusion that there would be no advantage in listing ALL
combinations of Pairs or Triplets for those that have and haven't
appeared, especially with consideration to the processing time, which
I think would be extreme.
Anyway, I do not have access to Excel for a couple of days so I would
just like to ask a couple of questions please with regard to your
following code. I am new to VBA so please be patient with me.
On Aug 13, 3:50 am, Vergel Adriano
wrote:
On Aug 12, 5:06 pm, Vergel Adriano
Give this a try.
Sub MostCommonPairAndTriplet()
Dim rng As Range
Dim c As Range
Dim strPair As String
Dim strTriplet As String
Dim wsResult As Worksheet
Dim lRow As Long
Dim lRow2 As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set rng = Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("A:F"))
If Not rng Is Nothing Then
'Get the result worksheet
On Error Resume Next
Set wsResult = ActiveWorkbook.Worksheets("Results")
If wsResult Is Nothing Then
Set wsResult = ActiveWorkbook.Worksheets.Add
wsResult.Name = "Results"
Else
wsResult.UsedRange.Delete
End If
'column labels
With wsResult
.Range("B1").Value = "Value1"
.Range("C1").Value = "Value2"
.Range("D1").Value = "Count"
.Range("F1").Value = "Value1"
.Range("G1").Value = "Value2"
.Range("H1").Value = "Value3"
.Range("I1").Value = "Count"
End With
On Error GoTo 0
'Find Pairs
lRow = 2
For Each c In rng
If c.Column <= 5 Then
strPair = c.Value & "_" & c.Offset(0, 1).Value
On Error Resume Next
lRow2 = Application.WorksheetFunction.Match(strPair,
wsResult.Range("A:A"), False)
If Err.Number 0 Then
wsResult.Range("A" & lRow).Value = strPair
wsResult.Range("B" & lRow).Value = c.Value
wsResult.Range("C" & lRow).Value = c.Offset(0, 1).Value
wsResult.Range("D" & lRow).Value = 1
lRow = lRow + 1
Else
wsResult.Range("D" & lRow2).Value = wsResult.Range("D" &
lRow2).Value + 1
End If
On Error GoTo 0
End If
Next c
'Find Triplets
lRow = 2
For Each c In rng
If c.Column <= 4 Then
strTriplet = c.Value & "_" & c.Offset(0, 1).Value & "_" &
c.Offset(0, 2).Value
On Error Resume Next
lRow2 = Application.WorksheetFunction.Match(strTriplet,
wsResult.Range("E:E"), False)
If Err.Number 0 Then
wsResult.Range("E" & lRow).Value = strTriplet
wsResult.Range("F" & lRow).Value = c.Value
wsResult.Range("G" & lRow).Value = c.Offset(0, 1).Value
wsResult.Range("H" & lRow).Value = c.Offset(0, 2).Value
wsResult.Range("I" & lRow).Value = 1
lRow = lRow + 1
Else
wsResult.Range("I" & lRow2).Value = wsResult.Range("I" &
lRow2).Value + 1
End If
On Error GoTo 0
End If
Next c
End If
wsResult.Columns("E").Clear
wsResult.Columns("A").Delete
'Sort the pairs
With wsResult
.Columns("A:C").Sort Key1:=.Range("C2"), Order1:=xlDescending
.Columns("E:H").Sort Key1:=.Range("H2"), Order1:=xlDescending
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
( 1 ) If ALL the 6 number combinations are in a sheet named "Input"
and in Cells "B3:G?" ( I use "G?" because the row number will
obviously change as more 6 number combinations are entered ), could we
use instead of ...
Set rng = Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("A:F"))
.... something like ...
Set rng = Intersect(Worksheets("Input").Range("B3:G" &
Range("B3").End(xlDown).Row
.... to set the range for ALL 6 number combinations?. Do we also need
to "Select" the "Input" sheet somewhere in the code?.
( 2 ) What if ...
Set rng = Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("A:F"))
.... or ...
Set rng = Intersect(Worksheets("Input").Range("B3:G" &
Range("B3").End(xlDown).Row
.... has no data, could we insert something like ...
If rng Is Nothing Then
Exit Sub
.... or such like?.
( 3 ) Could you please explain what the Dim variables ...
c
lRow
Irow2
.... actaually do please.
( 4 ) What for the Pairs does this actually mean and do please ...
If c.Column <= 5 Then
Thanks VERY much in Advance.
All the Best.
Paul
|