Can these data blocks be added to this code?

[SUSAN BAXTER]

Hi


I found some code that is very close to what I’ll like to use but I need some help to determine if I can add my list of additional blocks, below. I could use your opinion if you can attempt to add these blocks and future ones to this code or is this more designed for just the two original blocks. The code really looks extensive and great but beyond two blocks I can’t seem to get anymore to work. It could just be me, not sure.


The copied code, with no changes done to it at all is below.




New Data Blocks to be used
Set rng1 = Range("D22:I36")
Set rng2 = Range("J22:O36")
Set rng3 = Range("P22:U36")
Set rng4 = Range("V22:AA36")
Set rng5 = Range("AB22:AG36")
Set rng6 = Range("AH22:AM36")
Set rng7 = Range("AN22:AS36")
Set rng8 = Range("AT22:AY36")
Set rng9 = Range("AZ22:BE36")
Set rng10 = Range("BF22:BK36")



New Reference Blocks to be used '
Set rng11 = Range("BN22:BQ29") '
Set rng12 = Range("BR22:BU36")
Set rng13 = Range("BV22:BY36")
Set rng14 = Range("BZ22:CC36")
Set rng15 = Range("CD22:CG36")
Set rng16 = Range("CH22:CK36")

Set rng17 = Range("CL22:CO36")
Set rng18 = Range("CP22:CS36")
Set rng19 = Range("CT22:CW36")

Set rng20 = Range("CY22:DA36")

Sub PlaceNumbers()

 
Dim b As Range, rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range

 Dim last1 As Long, last2 As Long, rtar As Long, xtar As Long
 Set rng1 = Range("A5:E12")         
 Set rng2 = Range("G5:K12")                  

 Set rng3 = Range("M5:P12")         
 Set rng4 = Range("R5:U12")         

 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

 last1 = ActiveSheet.Cells(Application.Rows.Count, ColLetter(rng1.Columns(1).Column)).End(xlUp).Row
 last2 = ActiveSheet.Cells(Application.Rows.Count, ColLetter(rng3.Columns(1).Column)).End(xlUp).Row

 Application.ScreenUpdating = False
     For Each b In rng1.Offset(1, 2).Resize(, 1)

       If b <> "" Then
           rtar = Evaluate("=MATCH(" & ColLetter(rng1.Columns(2).Column) & rng1.Row & "&" & ColLetter(rng1.Columns(3).Column) & rng1.Row & "," & ColLetter(rng3.Columns(1).Column) & "1:" & ColLetter(rng3.Columns(1).Column) & last2 & "&" & ColLetter(rng3.Columns(3).Column) & "1:" & ColLetter(rng3.Columns(3).Column) & last2 & ",0)")

           xtar = Application.Match(c.Offset(0, -2), Range(ColLetter(rng3.Columns(1).Column) & rtar & ":" & ColLetter(rng3.Columns(1).Column) & last2), 0)

           With Application.WorksheetFunction

             b.Offset(0, 1) = .Index(Range(ColLetter(rng3.Columns(2).Column) & rtar & ":" & ColLetter(rng3.Columns(2).Column) & last2), xtar)
             b.Offset(0, 2) = .Index(Range(ColLetter(rng3.Columns(3).Column) & rtar & ":" & ColLetter(rng3.Columns(3).Column) & last2), xtar)

             b.Offset(0, 3) = .Index(Range(ColLetter(rng3.Columns(4).Column) & rtar & ":" & ColLetter(rng3.Columns(4).Column) & last2), xtar)
           End With

       End If
     Next b

 

 
     For Each b In rng2.Offset(1, 2).Resize(, 1)
       If b <> "" Then

           rtar = Evaluate("=MATCH(" & ColLetter(rng2.Columns(2).Column) & rng2.Row & "&" & ColLetter(rng2.Columns(3).Column) & rng2.Row & "," & ColLetter(rng3.Columns(1).Column) & "1:" & ColLetter(rng3.Columns(1).Column) & last2 & "&" & ColLetter(rng3.Columns(3).Column) & "1:" & ColLetter(rng3.Columns(3).Column) & last2 & ",0)")

           xtar = Application.Match(c.Offset(0, -2), Range(ColLetter(rng3.Columns(1).Column) & rtar & ":" & ColLetter(rng3.Columns(1).Column) & last2), 0)

           With Application.WorksheetFunction
             b.Offset(0, 1) = .Index(Range(ColLetter(rng3.Columns(2).Column) & rtar & ":" & ColLetter(rng3.Columns(2).Column) & last2), xtar)

             b.Offset(0, 2) = .Index(Range(ColLetter(rng3.Columns(3).Column) & rtar & ":" & ColLetter(rng3.Columns(3).Column) & last2), xtar)

             b.Offset(0, 3) = .Index(Range(ColLetter(rng3.Columns(4).Column) & rtar & ":" & ColLetter(rng3.Columns(4).Column) & last2), xtar)
           End With
       End If

     Next b

 

 
 Application.ScreenUpdating = True

 

 
 End Sub

<style type="text/css">p { margin-bottom: 0.25cm; direction: ltr; color: rgb(0, 0, 0); line-height: 115%; text-align: left; }p.western { font-family: "Liberation Serif", serif; font-size: 12pt; }p.cjk { font-family: "WenQuanYi Micro Hei"; font-size: 12pt; }p.ctl { font-family: "Lohit Devanagari"; font-size: 12pt; }a:link { }</style>

 

[Fluff]

Duplicate https://www.mrexcel.com/forum/excel-questions/1093735-data-block-code-2.html

Please do not post the same question multiple times. All clarifications, follow-ups, and bumps should be posted back to the original thread.
Per forum rules, posts of a duplicate nature will be locked or deleted (rule 12 here: Forum Rules).