Data Block Code

[SUSAN BAXTER]

Hi


I was looking for help to create some data block code. Whats really important is the ability to add more data blocks (anywhere on my sheet) over time and that's why I have chosen data blocks (hope I’m correct). I have found some code and could include it in the post if that will save some time, please advise.


I have two sets of data blocks as an example:


1^stset is B6 to E17 (so 4 columns over and 12 rows down), column B is formatted as text and C/D/E is formatted as numbers. The second data block, is where the data source is located in a true event and are located at cells N6 to P17 (so only 3 columns over and 12 rows down), columns C/D/E are formatted as numbers.


2^nd set is H6 to K10 (so 4 columns over and 4 rows down), column H is formatted as text and I/J/K is formatted as numbers. The second data block, is where the data source is located in a true event and are located in a true event and are located at cells N22 to P25 (so 3 columns over and 4 rows down), columns I/J/K are formatted as numbers.


The code would search the range B6:B12,H6:H10 for any sets (9-9, 11-1, 1-1 etc.) of numbers. As an example it finds 9-3 in cell B8 which would be a true result. The code would then (I’m sure how to write this up so please advise if it’s not clear) would have to determine that the true result was on the 3^rd row down and search the data block N6:P17 to find the third row down which would be N8 and write the numbers to cells C8, O8 and write the numbers to cells D8, P8 and write the numbers to cells E8. The code would continue with the rest of the range to find any other true events and if none end.

Thanks so much for any help/advice.





<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>

 

[SUSAN BAXTER]

Have I lost you?

 

[SUSAN BAXTER]

I’m trying to see if I can add the following data blocks to the code below, which is the original and unchanged.


Data Blocks
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")



Reference Blocks '
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 c 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
 

 
 ' In this Version, Both Data Blocks are located one under the other starting in the same Column '
 ' Data Blocks of 8 Rows      
                                                                     '
 Set rng1 = Range("C9:H16")                                                                      '
 Set rng2 = Range("C18:H25")                                                                     '
 '                                                                                               '
 ' In this Version, Both Ref. Blocks are located one under the other starting in the same Column '
 ' Reference Blocks of 8 Rows                                                                    '
 Set rng3 = Range("P15:S22")                                                                      '
 Set rng4 = Range("P24:S31")                                                                     '
 

 
 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 c In rng1.Offset(1, 2).Resize(, 1)
       If c <> "" 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
             c.Offset(0, 1) = .Index(Range(ColLetter(rng3.Columns(2).Column) & rtar & ":" & ColLetter(rng3.Columns(2).Column) & last2), xtar)
             c.Offset(0, 2) = .Index(Range(ColLetter(rng3.Columns(3).Column) & rtar & ":" & ColLetter(rng3.Columns(3).Column) & last2), xtar)
             c.Offset(0, 3) = .Index(Range(ColLetter(rng3.Columns(4).Column) & rtar & ":" & ColLetter(rng3.Columns(4).Column) & last2), xtar)
           End With
       End If
     Next c
 

 
     For Each c In rng2.Offset(1, 2).Resize(, 1)
       If c <> "" 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
             c.Offset(0, 1) = .Index(Range(ColLetter(rng3.Columns(2).Column) & rtar & ":" & ColLetter(rng3.Columns(2).Column) & last2), xtar)
             c.Offset(0, 2) = .Index(Range(ColLetter(rng3.Columns(3).Column) & rtar & ":" & ColLetter(rng3.Columns(3).Column) & last2), xtar)
             c.Offset(0, 3) = .Index(Range(ColLetter(rng3.Columns(4).Column) & rtar & ":" & ColLetter(rng3.Columns(4).Column) & last2), xtar)
           End With
       End If
     Next c
 

 
 Application.ScreenUpdating = True
 

 
 End Sub
 

 
 Function ColLetter(Collet As Integer) As String

     ColLetter = Split(Cells(1, Collet).Address, "$")(1)
  End Function

<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>

 

[steve the fish]

Does it work as required as is for the 2 ranges? Where is rng4 used?

 

[SUSAN BAXTER]

Hi
Thanks for your reply I have got the code to work using the original code (has 2 blocks in it).
rng1 and rng2 is the search range and rng3 and rng4 is the data source. Hope this is clear. When I try to add even 1 more range and data source I can't get it to work. Even just your opinion would be greatly appreciated on whether this is the code to use when adding many more data blocks.
Thanks so much.

 

[steve the fish]

Where is rng4 used in the supplied code? Im inferring that it isnt.

 

[SUSAN BAXTER]

I just checked the code again and I see what you mean, I don't know. The code has the line
Set rng4 = Range("P24:S31") with a cell range. I don't know what to say!

 

[steve the fish]

Once you set a range to a variable you would then normally use it later on! You have two loops running consecutively. One uses rng1 and rng3, the other rng2 and rng3. Is that 2nd rng3 meant to be rng4?

 

[SUSAN BAXTER]

I didn't write it but you may be right on the second rng3 sb a 4.

 

[steve the fish]

Have you ever run the supplied code and did it do what you expected??

 

[SUSAN BAXTER]

I tried the first data block and it worked.