Please need help code modification due to change of layout.

K

Kishan

Well-known Member
Joined
Mar 15, 2011
Messages
1,648
Office Version
  1. 2010
Platform
  1. Windows
The code below from MickG, is working perfect if the headers are placed in Range (P1:AD1) with the lay out below.</SPAN></SPAN>

Code: 
[COLOR=#000080]Sub[/COLOR] MG22Oct22
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Dn [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Ac [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Dim[/COLOR] n [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Dim[/COLOR] Temp [COLOR=navy]As[/COLOR] [COLOR=navy]String[/COLOR]
[COLOR=navy]Dim[/COLOR] R [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Dim[/COLOR] p [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]

[COLOR=navy]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
Rng.Offset(, 15).Resize(, 15).ClearContents
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
    ReDim ray(1 To 14, 1 To 2)
    Temp = Dn
    n = 1
        [COLOR=navy]For[/COLOR] Ac = 1 To 14
            [COLOR=navy]If[/COLOR] Not Dn(, Ac) = Temp [COLOR=navy]Then[/COLOR]
                n = n + 1
                Temp = Dn(, Ac)
            [COLOR=navy]End[/COLOR] If
    ray(n, 1) = Dn(, Ac): ray(n, 2) = ray(n, 2) + 1
[COLOR=navy]Next[/COLOR] Ac
p = 1
[COLOR=navy]For[/COLOR] Ac = 1 To n
    [COLOR=navy]For[/COLOR] R = p To 15
        [COLOR=navy]If[/COLOR] Not ray(Ac, 1) = Cells(1, R + 15) [COLOR=navy]Then[/COLOR]
        [COLOR=navy]Else[/COLOR]
          Cells(Dn.Row, R + 15) = ray(Ac, 2)
          p = R
          [COLOR=navy]Exit[/COLOR] For
       [COLOR=navy]End[/COLOR] If
    [COLOR=navy]Next[/COLOR] R
[COLOR=navy]Next[/COLOR] Ac
[COLOR=navy]Next[/COLOR] Dn

Book1
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACADAE
1P1P2P3P4P5P6P7P8P9P10P11P12P13P141X21X21X21X21X2
21X21X21X21X21X11111111111111
3111XX22X11111X322151
422XX11X211XXX222211231
51XXXX1111XX22X144221
6X122XX22111111112226
7222122222XXXXX3155
81XX22XX22XX22X12222221
91X2X21X21X21X211111111111111
101XXX11111XX212135221
111X21X21X21X21211111111111111
12
13
Sheet1


But now I need to change the layout as shown below. For that I need help that code to be modified to work with the layout below. I tried a lot but could not get it work</SPAN></SPAN>


Book1
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACADAEAFAGAHAIAJAKALAMANAOAPAQARASATAUAVAWAXAYAZ
1
2
3
4
5P1P2P3P4P5P6P7P8P9P10P11P12P13P141X21X21X21X21X2
61X21X21X21X21X11111111111111
7111XX22X11111X322151
822XX11X211XXX222211231
91XXXX1111XX22X144221
10X122XX22111111112226
11222122222XXXXX3155
121XX22XX22XX22X12222221
131X2X21X21X21X211111111111111
141XXX11111XX212135221
151X21X21X21X21211111111111111
16
17
Sheet2


Please help </SPAN></SPAN>

Regards,</SPAN></SPAN>
Kishan</SPAN></SPAN>
 
Last edited:

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Sort by date Sort by votes
Try this:-
Code: 
[COLOR="Navy"]Sub[/COLOR] MG25Jul32
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Temp [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] R [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] p [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("C6"), Range("C" & Rows.Count).End(xlUp))
Rng.Offset(, 15).Resize(, 15).ClearContents
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    ReDim ray(1 To 14, 1 To 2)
    Temp = Dn
    n = 1
        [COLOR="Navy"]For[/COLOR] Ac = 1 To 14
            [COLOR="Navy"]If[/COLOR] Not Dn(, Ac) = Temp [COLOR="Navy"]Then[/COLOR]
                n = n + 1
                Temp = Dn(, Ac)
            [COLOR="Navy"]End[/COLOR] If
    ray(n, 1) = Dn(, Ac): ray(n, 2) = ray(n, 2) + 1
[COLOR="Navy"]Next[/COLOR] Ac
p = 3
[COLOR="Navy"]For[/COLOR] Ac = 1 To n
    [COLOR="Navy"]For[/COLOR] R = p To 17
        
        [COLOR="Navy"]If[/COLOR] Not ray(Ac, 1) = Cells(5, R + 15) [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]Else[/COLOR]
          Cells(Dn.Row, R + 15) = ray(Ac, 2)
          p = R
          [COLOR="Navy"]Exit[/COLOR] For
       [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] R
[COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
MickG said:
Try this:-
Code: 
[COLOR=navy]Sub[/COLOR] MG25Jul32
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Dn [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Ac [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Dim[/COLOR] n [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Dim[/COLOR] Temp [COLOR=navy]As[/COLOR] [COLOR=navy]String[/COLOR]
[COLOR=navy]Dim[/COLOR] R [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Dim[/COLOR] p [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Set[/COLOR] Rng = Range(Range("C6"), Range("C" & Rows.Count).End(xlUp))
Rng.Offset(, 15).Resize(, 15).ClearContents
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
    ReDim ray(1 To 14, 1 To 2)
    Temp = Dn
    n = 1
        [COLOR=navy]For[/COLOR] Ac = 1 To 14
            [COLOR=navy]If[/COLOR] Not Dn(, Ac) = Temp [COLOR=navy]Then[/COLOR]
                n = n + 1
                Temp = Dn(, Ac)
            [COLOR=navy]End[/COLOR] If
    ray(n, 1) = Dn(, Ac): ray(n, 2) = ray(n, 2) + 1
[COLOR=navy]Next[/COLOR] Ac
p = 3
[COLOR=navy]For[/COLOR] Ac = 1 To n
    [COLOR=navy]For[/COLOR] R = p To 17
        
        [COLOR=navy]If[/COLOR] Not ray(Ac, 1) = Cells(5, R + 15) [COLOR=navy]Then[/COLOR]
        [COLOR=navy]Else[/COLOR]
          Cells(Dn.Row, R + 15) = ray(Ac, 2)
          p = R
          [COLOR=navy]Exit[/COLOR] For
       [COLOR=navy]End[/COLOR] If
    [COLOR=navy]Next[/COLOR] R
[COLOR=navy]Next[/COLOR] Ac
[COLOR=navy]Next[/COLOR] Dn
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
Click to expand...
Hi Mike, really it has been my pleasure using your code since last 6, 7 years. And today when I required a modification you are here to help. I just change column nº 15 To 34, to obtain results in columns AK:AY</SPAN></SPAN>

I do appreciate your constantan work and solving problems for everyone.</SPAN></SPAN>

Thank you for your prompt reply and for giving your precious time to making it work with new layout.</SPAN></SPAN>

Good Luck Mike.</SPAN></SPAN>

Kind Regards,</SPAN></SPAN>
Kishan</SPAN></SPAN> :)</SPAN></SPAN>
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Solved
Update to existing Move data macro
2
Replies
11
Views
370
Alex Blakenburg
A
montecarlo2012
  • Solved
vba=Loop through each row in the data range.(B2:F10000)
Replies
9
Views
2K
montecarlo2012
montecarlo2012
montecarlo2012
  • Solved
Read sheet 3 results on sheet 1
Replies
4
Views
504
montecarlo2012
montecarlo2012
P
  • Question
ListBox Click to textbox & delete row
Replies
0
Views
347
pure vito
P
gtd526
  • Solved
Move selected row to top of range
Replies
6
Views
146
gtd526
gtd526

Forum statistics

Threads
1,215,510
Messages
6,125,234
Members
449,216
Latest member
biglake87

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