VBA Frequency Transposed

[Stephen_IV]

I have a set of data in column A that I would like transposed using VBA. I would like to put the data under the proper bin. Bins are 0-64, 65-72, 73-82, 83-90, 91-100.

<table class="tableizer-table">
<thead><tr class="tableizer-firstrow"><th>20</th></tr></thead><tbody>
<tr><td>37</td></tr>
<tr><td>57</td></tr>
<tr><td>62</td></tr>
<tr><td>64</td></tr>
<tr><td>65</td></tr>
<tr><td>71</td></tr>
<tr><td>70</td></tr>
<tr><td>78</td></tr>
<tr><td>78</td></tr>
<tr><td>78</td></tr>
<tr><td>79</td></tr>
<tr><td>82</td></tr>
<tr><td>87</td></tr>
<tr><td>88</td></tr>
<tr><td>88</td></tr>
<tr><td>88</td></tr>
<tr><td>89</td></tr>
<tr><td>89</td></tr>
<tr><td>89</td></tr>
<tr><td>92</td></tr>
<tr><td>93</td></tr>
<tr><td>94</td></tr>
<tr><td>100</td></tr>
<tr><td>100</td></tr>
</tbody></table>

To this starting in Column C:

<table class="tableizer-table">
<thead><tr class="tableizer-firstrow"><th>0-64</th><th>65-72</th><th>73-82</th><th>83-90</th><th>91-100</th></tr></thead><tbody>
<tr><td>20</td><td>65</td><td>78</td><td>87</td><td>92</td></tr>
<tr><td>37</td><td>71</td><td>78</td><td>88</td><td>93</td></tr>
<tr><td>57</td><td>70</td><td>78</td><td>88</td><td>94</td></tr>
<tr><td>62</td><td> </td><td>79</td><td>88</td><td>100</td></tr>
<tr><td>64</td><td> </td><td>82</td><td>89</td><td>100</td></tr>
<tr><td> </td><td> </td><td> </td><td>89</td><td> </td></tr>
<tr><td> </td><td> </td><td> </td><td>89</td><td></td></tr>
</tbody></table>

Thanks in advance!!!

 

[MickG]

With your criteria range in cells "C1: G1" and your data in column "A" starting "A2".
Try this for results starting "C2".

[COLOR="Navy"]Sub[/COLOR] MG17Feb24
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Sp [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Rng1 [COLOR="Navy"]As[/COLOR] Range, R [COLOR="Navy"]As[/COLOR] Range, K [COLOR="Navy"]As[/COLOR] Variant, Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng1 = Range("C1:G1")
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))

[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] Rng1: .Item(R.Value) = R.Value: [COLOR="Navy"]Next[/COLOR] R
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
   [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
    Sp = Split(K, "-")
        [COLOR="Navy"]If[/COLOR] Dn >= Val(Sp(0)) And Dn <= Val(Sp(1)) [COLOR="Navy"]Then[/COLOR]
            .Item(K) = .Item(K) & "," & Dn.Value
            [COLOR="Navy"]Exit[/COLOR] For
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]Next[/COLOR] Dn
Ac = 2
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
    Sp = Split(.Item(K), ",")
        Ac = Ac + 1
            Cells(1, Ac).Resize(UBound(Sp) + 1).Value = Application.Transpose(Sp)
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Stephen_IV]

Mick amazing!!!!!!! Thank you so much! It works perfectly! I appreciate all of your help! Thanks again!

 

[MickG]

You're very welcome