Code Required Please

Dazzawm

Dazzawm

Well-known Member
Joined
Jan 24, 2011
Messages
3,783
Office Version
  1. 365
Platform
  1. Windows
I need a code that will firstly look at column A and column B. If the data in those are the same then look at the very first start year in column C and the very last year in column D and insert a row for the missing years. I hope the table explains better.



<TABLE style="BACKGROUND-COLOR: #ffffff; PADDING-LEFT: 2pt; PADDING-RIGHT: 2pt; FONT-FAMILY: Arial,Arial; FONT-SIZE: 10pt" border=1 cellSpacing=0 cellPadding=0><COLGROUP><COL style="WIDTH: 30px"><COL style="WIDTH: 99px"><COL style="WIDTH: 129px"><COL style="WIDTH: 35px"><COL style="WIDTH: 35px"></COLGROUP><TBODY><TR style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt"><TD></TD><TD>A</TD><TD>B</TD><TD>C</TD><TD>D</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">1</TD><TD style="TEXT-ALIGN: left">Make</TD><TD style="TEXT-ALIGN: left">Model</TD><TD style="TEXT-ALIGN: left">SY</TD><TD style="TEXT-ALIGN: left">EY</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">2</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left">1963</TD><TD style="TEXT-ALIGN: left">1966</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">3</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left">1963</TD><TD style="TEXT-ALIGN: left">1966</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">4</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left">1963</TD><TD style="TEXT-ALIGN: left">1966</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">5</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left">1963</TD><TD style="TEXT-ALIGN: left">1966</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">6</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left">1967</TD><TD style="TEXT-ALIGN: left">1969</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">7</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left">1967</TD><TD style="TEXT-ALIGN: left">1969</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">8</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left">1969</TD><TD style="TEXT-ALIGN: left">1970</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">9</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left">1969</TD><TD style="TEXT-ALIGN: left">1970</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">10</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left">1967</TD><TD style="TEXT-ALIGN: left">1970</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">11</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left">1967</TD><TD style="TEXT-ALIGN: left">1970</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">12</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left">1970</TD><TD style="TEXT-ALIGN: left">1973</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">13</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left">1970</TD><TD style="TEXT-ALIGN: left">1975</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">14</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left">1976</TD><TD style="TEXT-ALIGN: left">1979</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">15</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left">1976</TD><TD style="TEXT-ALIGN: left">1979</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">16</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left">1976</TD><TD style="TEXT-ALIGN: left">1979</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">17</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left">1976</TD><TD style="TEXT-ALIGN: left">1979</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">18</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left">1970</TD><TD style="TEXT-ALIGN: left">1982</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">19</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left">1979</TD><TD style="TEXT-ALIGN: left">1982</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">20</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left">1973</TD><TD style="TEXT-ALIGN: left">1982</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">21</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left">1979</TD><TD style="TEXT-ALIGN: left">1982</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">22</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left">1979</TD><TD style="TEXT-ALIGN: left">1983</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">23</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left">1979</TD><TD style="TEXT-ALIGN: left">1983</TD></TR></TBODY></TABLE>

As you can see in the example all the data in each row in column A & B are the same. It needs to look at the lowest year in all the rows in column C which is 1963 and the latest year in column D which is 1983 and then make sure there is an entry for every year in between these 2 years. Then when the data changes in column A & B do the same again. Then if possible delete column D at the very end of the code as it is not needed So this is what it will look after. I have coloured what the code needs to add.

The cells not coloured were the ones that were already in column C!

I hope this makes sense! Thanks.


<TABLE style="BACKGROUND-COLOR: #ffffff; PADDING-LEFT: 2pt; PADDING-RIGHT: 2pt; FONT-FAMILY: Arial,Arial; FONT-SIZE: 10pt" border=1 cellSpacing=0 cellPadding=0><COLGROUP><COL style="WIDTH: 30px"><COL style="WIDTH: 99px"><COL style="WIDTH: 129px"><COL style="WIDTH: 35px"></COLGROUP><TBODY><TR style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt"><TD></TD><TD>A</TD><TD>B</TD><TD>C</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">1</TD><TD style="TEXT-ALIGN: left">Make</TD><TD style="TEXT-ALIGN: left">Model</TD><TD style="TEXT-ALIGN: left">SY</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">2</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left">1963</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">3</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left; BACKGROUND-COLOR: #ffff00">1964</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">4</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left; BACKGROUND-COLOR: #ffff00">1965</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">5</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left; BACKGROUND-COLOR: #ffff00">1966</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">6</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left">1967</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">7</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left; BACKGROUND-COLOR: #ffff00">1968</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">8</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left">1969</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">9</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left">1970</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">10</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left; BACKGROUND-COLOR: #ffff00">1971</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">11</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left; BACKGROUND-COLOR: #ffff00">1972</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">12</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left">1973</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">13</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left; BACKGROUND-COLOR: #ffff00">1974</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">14</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left; BACKGROUND-COLOR: #ffff00">1975</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">15</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left">1976</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">16</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left; BACKGROUND-COLOR: #ffff00">1977</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">17</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left; BACKGROUND-COLOR: #ffff00">1978</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">18</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left">1979</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">19</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left; BACKGROUND-COLOR: #ffff00">1980</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">20</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left; BACKGROUND-COLOR: #ffff00">1981</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">21</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left; BACKGROUND-COLOR: #ffff00">1982</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">22</TD><TD style="TEXT-ALIGN: left">Ford</TD><TD style="TEXT-ALIGN: left">Cortina</TD><TD style="TEXT-ALIGN: left; BACKGROUND-COLOR: #ffff00">1983</TD></TR></TBODY></TABLE>
 
Last edited:

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
Sort by date Sort by votes
I know this is a tricky one but please let me know if you need any clarification.
 
Upvote 0
so do you just want the column C to change all its value so there is one entry for each year between min in column C and max in column D, and do the values in A and B need to change at all?
 
Upvote 0
Yes I think thats what I want! Because the values in A & B are the same so it will be the range of A2:D23 in this case.
 
Upvote 0
Hi Darren,

I think this should work with any make, model, and year ranges.

With your original list on sheet 1, and with column headers from A,B, & C on sheet 2, the following code should work:
Code: 
Sub Relist()
Sheets(1).Activate
With Sheets(2)
    R = Range("A" & Rows.Count).End(xlUp).Row
    For a = 2 To R
        x1 = Cells(a, 1): x2 = Cells(a, 2): x3 = Val(Cells(a, 3)): x4 = Val(Cells(a, 4))
        For dat = x3 To x4
            RR = .Range("A" & Rows.Count).End(xlUp).Row
            For b = 1 To RR
                If .Cells(b, 1) = x1 And .Cells(b, 2) = x2 And Val(.Cells(b, 3)) = dat Then GoTo nextdat
            Next b
            .Cells(b, 1) = x1: .Cells(b, 2) = x2: .Cells(b, 3) = dat
nextdat:
        Next dat
nexta:
    Next a
End With
Sheets(2).Activate
Columns("A:C").Select
    Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Key2:=Range("B2") _
        , Order2:=xlAscending, Key3:=Range("A2"), Order3:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
        xlSortNormal
Cells(1, 1).Select
End Sub

Give it a try
 
Upvote 0
And then you want it to delete column D and delete any rows left over.

By that I mean if min in col C is 1963 and max in D is 1986, then that is only 23 rows, if there were originally like 25 would you have me delete those last 2?
 
Upvote 0
Try this:-
Results column start "F1"
Code: 
[COLOR="Navy"]Sub[/COLOR] MG21Oct52
[COLOR="Navy"]Dim[/COLOR] Rng     [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn      [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Twn     [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Q, K
[COLOR="Navy"]Dim[/COLOR] ac      [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] c       [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] tot     [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
    [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] Dn [COLOR="Navy"]In[/COLOR] Rng
            Twn = Dn & Dn(, 2)
                [COLOR="Navy"]If[/COLOR] Not .Exists(Twn) [COLOR="Navy"]Then[/COLOR]
                    .Add Twn, Array(Dn, Dn(, 2), Dn(, 3), Dn(, 4))
                [COLOR="Navy"]Else[/COLOR]
                    Q = .Item(Twn)
                        Q(2) = Application.Min(Q(2), Dn(, 3))
                        Q(3) = Application.max(Q(3), Dn(, 4))
                    .Item(Twn) = Q
                [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .Keys
    tot = tot + (.Item(K)(3) - .Item(K)(2))
[COLOR="Navy"]Next[/COLOR] K
ReDim ray(1 To tot + .Count, 1 To 3)
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .Keys
        [COLOR="Navy"]For[/COLOR] ac = .Item(K)(2) To .Item(K)(3)
            c = c + 1
            ray(c, 1) = .Item(K)(0)
            ray(c, 2) = .Item(K)(1)
            ray(c, 3) = ac
        [COLOR="Navy"]Next[/COLOR] ac
    [COLOR="Navy"]Next[/COLOR] K
Range("F1").Resize(tot + .Count, 3) = ray
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Thanks for everyones help. MickG its my fault I should have said your code does everything I need it to but I don't need the end year as a seperate row i.e if the year range is 1963 to 1984 I dont need 1984 as a row. Thanks.
 
Upvote 0
Perhaps this:-
Code: 
[COLOR="Navy"]Sub[/COLOR] MG21Oct55
[COLOR="Navy"]Dim[/COLOR] Rng     [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn      [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Twn     [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Q
[COLOR="Navy"]Dim[/COLOR] K
[COLOR="Navy"]Dim[/COLOR] ac      [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] c       [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] tot     [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
    [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] Dn [COLOR="Navy"]In[/COLOR] Rng
            Twn = Dn & Dn(, 2)
                [COLOR="Navy"]If[/COLOR] Not .Exists(Twn) [COLOR="Navy"]Then[/COLOR]
                    .Add Twn, Array(Dn, Dn(, 2), Dn(, 3), Dn(, 4))
                [COLOR="Navy"]Else[/COLOR]
                    Q = .Item(Twn)
                        Q(2) = Application.Min(Q(2), Dn(, 3))
                        Q(3) = Application.max(Q(3), Dn(, 4))
                    .Item(Twn) = Q
                [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .Keys
    tot = tot + (.Item(K)(3) - .Item(K)(2))
[COLOR="Navy"]Next[/COLOR] K
ReDim ray(1 To tot, 1 To 3)
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .Keys
        [COLOR="Navy"]For[/COLOR] ac = .Item(K)(2) To .Item(K)(3) - 1
            c = c + 1
            ray(c, 1) = .Item(K)(0)
            ray(c, 2) = .Item(K)(1)
            ray(c, 3) = ac
        [COLOR="Navy"]Next[/COLOR] ac
    [COLOR="Navy"]Next[/COLOR] K
Range("F1").Resize(tot, 3) = ray
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Solved
VBA Function to Paste Table into Outlook Email Resulting in HTML language in Email
Replies
8
Views
537
smozgur
smozgur
E
  • Question Question
VBA code clean up
Replies
9
Views
469
mumps
mumps
E
  • Question Question
Adding a custom message.
Replies
1
Views
622
Micron
M
C
  • Solved
Excel 2016 32bit VBA Pulling info from Website to Sheet
Replies
2
Views
1K
CrashOD
C
V
  • Question Question
Issue with scraping with VBA
Replies
1
Views
686
John_w
J

Forum statistics

Threads
1,223,098
Messages
6,170,103
Members
452,302
Latest member
TaMere

Share this page

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