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

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
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
732
Alex Blakenburg
A
montecarlo2012
  • Solved
vba=Loop through each row in the data range.(B2:F10000)
Replies
9
Views
2K
montecarlo2012
montecarlo2012
K
  • Solved
Using VBA to select a color coded cell
2
Replies
11
Views
933
Alex Blakenburg
A
E
  • Question Question
VBA code clean up
Replies
9
Views
536
mumps
mumps
zookeepertx
  • Question Question
Having trouble "deciphering" some code so I can see how it works
Replies
7
Views
372
zookeepertx
zookeepertx

Forum statistics

Threads
1,223,884
Messages
6,175,177
Members
452,615
Latest member
bogeys2birdies

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