Modification of existing Code to put results in numeric order

dwrowe001

Board Regular
Joined
Mar 12, 2017
Messages
53
Office Version
  1. 2016
Platform
  1. Windows
Hello all,
Dante and Peter helped me with my original request, which is posted here: Number Search / return corresponding number strings
Sample 1 picture is how the returned numbers look. I need it modified a little so that the returned numbers are also put order from the highest hits to least returned hits. See Sample 2 picture.

The results of the returned numbers are put in columns J, L, N and P along with how many hits each of those numbers have next to them in columns K, M, O and Q. The way the returned numbers are makes difficult
to sort. Having the results in order by hit quantity (Sample 2 picture) would make sorting easier.

what I would like is to have the returned numbers also arranged in order of the number of hits found in columns K, M, O and Q of each of the actual numbers found in Columns J, L, N and P. If there are several numbers with the same hit quantity, then put returned numbers in numerical order smallest to bigger... for example, the numbers 7, 18, 51 and 57 all had 3 hits each... so those 4 numbers can be in numerical order. Next are the returned numbers with 2 hits each, so put those number is numerical order smallest 22 to biggest 89. Next comes the returned numbers with 1 hit each, 5 to 98.

VBA Code:
Sub Number_Search()
  Dim dic As Object
  Dim a As Variant, b As Variant
  Dim i&, j&, n&, jj&, ii&, y&, k&, m&, nRow&, nCol&
  Dim num As String, myNum As String
  Dim f As Range
 
  Set dic = CreateObject("Scripting.Dictionary")
  num = Range("J2").Text
 
  If num = "" Then
    MsgBox "Enter value in J2"
    Exit Sub
  End If
 
  Set f = Range("C:F").Find(num, , xlValues, xlWhole)
  If f Is Nothing Then
    MsgBox "Number does not exists"
    Exit Sub
  End If
 
  a = Range("C4:F" & Range("C" & Rows.Count).End(3).Row + 4).Value
  n = WorksheetFunction.CountIf(Range("C:F"), num)
  ReDim b(1 To n * 4, 1 To 8)
  y = -1
 
  Range("J4:Q" & Rows.Count).ClearContents
  For i = 1 To UBound(a, 1)
    For j = 1 To UBound(a, 2)
      myNum = "" & a(i, j)
      If myNum = num Then
        y = y + 2
        m = j + 1
        k = -1
        For ii = i To i + 2
          For jj = m To UBound(a, 2)
            myNum = "" & a(ii, jj)
            If myNum <> "" Then
              If Not dic.exists(myNum) Then
                k = k + 2
                If k = 9 Then
                  k = 1
                  y = y + 1
                End If
                dic(myNum) = y & "|" & k
              End If
              nRow = Split(dic(myNum), "|")(0)
              nCol = Split(dic(myNum), "|")(1)
              b(nRow, nCol) = myNum
              b(nRow, nCol + 1) = b(nRow, nCol + 1) + 1
            End If
          Next jj
          m = 1
        Next ii
      End If
    Next j
  Next i
 
  Range("J4").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

Thank you,

Dave
 

Attachments

  • Sample 1.png
    Sample 1.png
    16.8 KB · Views: 12
  • Sample 2.png
    Sample 2.png
    21.6 KB · Views: 11

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
Hello all,
Dante and Peter helped me with my original request, which is posted here: Number Search / return corresponding number strings
Sample 1 picture is how the returned numbers look. I need it modified a little so that the returned numbers are also put order from the highest hits to least returned hits. See Sample 2 picture.

The results of the returned numbers are put in columns J, L, N and P along with how many hits each of those numbers have next to them in columns K, M, O and Q. The way the returned numbers are makes difficult
to sort. Having the results in order by hit quantity (Sample 2 picture) would make sorting easier.

what I would like is to have the returned numbers also arranged in order of the number of hits found in columns K, M, O and Q of each of the actual numbers found in Columns J, L, N and P. If there are several numbers with the same hit quantity, then put returned numbers in numerical order smallest to bigger... for example, the numbers 7, 18, 51 and 57 all had 3 hits each... so those 4 numbers can be in numerical order. Next are the returned numbers with 2 hits each, so put those number is numerical order smallest 22 to biggest 89. Next comes the returned numbers with 1 hit each, 5 to 98.

VBA Code:
Sub Number_Search()
  Dim dic As Object
  Dim a As Variant, b As Variant
  Dim i&, j&, n&, jj&, ii&, y&, k&, m&, nRow&, nCol&
  Dim num As String, myNum As String
  Dim f As Range
 
  Set dic = CreateObject("Scripting.Dictionary")
  num = Range("J2").Text
 
  If num = "" Then
    MsgBox "Enter value in J2"
    Exit Sub
  End If
 
  Set f = Range("C:F").Find(num, , xlValues, xlWhole)
  If f Is Nothing Then
    MsgBox "Number does not exists"
    Exit Sub
  End If
 
  a = Range("C4:F" & Range("C" & Rows.Count).End(3).Row + 4).Value
  n = WorksheetFunction.CountIf(Range("C:F"), num)
  ReDim b(1 To n * 4, 1 To 8)
  y = -1
 
  Range("J4:Q" & Rows.Count).ClearContents
  For i = 1 To UBound(a, 1)
    For j = 1 To UBound(a, 2)
      myNum = "" & a(i, j)
      If myNum = num Then
        y = y + 2
        m = j + 1
        k = -1
        For ii = i To i + 2
          For jj = m To UBound(a, 2)
            myNum = "" & a(ii, jj)
            If myNum <> "" Then
              If Not dic.exists(myNum) Then
                k = k + 2
                If k = 9 Then
                  k = 1
                  y = y + 1
                End If
                dic(myNum) = y & "|" & k
              End If
              nRow = Split(dic(myNum), "|")(0)
              nCol = Split(dic(myNum), "|")(1)
              b(nRow, nCol) = myNum
              b(nRow, nCol + 1) = b(nRow, nCol + 1) + 1
            End If
          Next jj
          m = 1
        Next ii
      End If
    Next j
  Next i
 
  Range("J4").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

Thank you,

Dave

I need to mention, the
Hello all,
Dante and Peter helped me with my original request, which is posted here: Number Search / return corresponding number strings
Sample 1 picture is how the returned numbers look. I need it modified a little so that the returned numbers are also put order from the highest hits to least returned hits. See Sample 2 picture.

The results of the returned numbers are put in columns J, L, N and P along with how many hits each of those numbers have next to them in columns K, M, O and Q. The way the returned numbers are makes difficult
to sort. Having the results in order by hit quantity (Sample 2 picture) would make sorting easier.

what I would like is to have the returned numbers also arranged in order of the number of hits found in columns K, M, O and Q of each of the actual numbers found in Columns J, L, N and P. If there are several numbers with the same hit quantity, then put returned numbers in numerical order smallest to bigger... for example, the numbers 7, 18, 51 and 57 all had 3 hits each... so those 4 numbers can be in numerical order. Next are the returned numbers with 2 hits each, so put those number is numerical order smallest 22 to biggest 89. Next comes the returned numbers with 1 hit each, 5 to 98.

VBA Code:
Sub Number_Search()
  Dim dic As Object
  Dim a As Variant, b As Variant
  Dim i&, j&, n&, jj&, ii&, y&, k&, m&, nRow&, nCol&
  Dim num As String, myNum As String
  Dim f As Range
 
  Set dic = CreateObject("Scripting.Dictionary")
  num = Range("J2").Text
 
  If num = "" Then
    MsgBox "Enter value in J2"
    Exit Sub
  End If
 
  Set f = Range("C:F").Find(num, , xlValues, xlWhole)
  If f Is Nothing Then
    MsgBox "Number does not exists"
    Exit Sub
  End If
 
  a = Range("C4:F" & Range("C" & Rows.Count).End(3).Row + 4).Value
  n = WorksheetFunction.CountIf(Range("C:F"), num)
  ReDim b(1 To n * 4, 1 To 8)
  y = -1
 
  Range("J4:Q" & Rows.Count).ClearContents
  For i = 1 To UBound(a, 1)
    For j = 1 To UBound(a, 2)
      myNum = "" & a(i, j)
      If myNum = num Then
        y = y + 2
        m = j + 1
        k = -1
        For ii = i To i + 2
          For jj = m To UBound(a, 2)
            myNum = "" & a(ii, jj)
            If myNum <> "" Then
              If Not dic.exists(myNum) Then
                k = k + 2
                If k = 9 Then
                  k = 1
                  y = y + 1
                End If
                dic(myNum) = y & "|" & k
              End If
              nRow = Split(dic(myNum), "|")(0)
              nCol = Split(dic(myNum), "|")(1)
              b(nRow, nCol) = myNum
              b(nRow, nCol + 1) = b(nRow, nCol + 1) + 1
            End If
          Next jj
          m = 1
        Next ii
      End If
    Next j
  Next i
 
  Range("J4").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

Thank you,

Dave

all,

I neglected to mention in my OP that the array of numbers the code is searching on is from C4 down to F9762.. a large array. The returned results are many.

Dave
 
Upvote 0

Forum statistics

Threads
1,223,893
Messages
6,175,240
Members
452,621
Latest member
Laura_PinksBTHFT

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top