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>

 

[steve the fish]

So you havent tried the supplied code then? Is it your aim to run the first block then run all the other pairs of blocks in a loop?

 

[SUSAN BAXTER]

I used the code supplied. If I added 20 more blocks would I have to copy almost most of the code and just change the rng numbers. Is this the best way do accomplish the task?

 

[steve the fish]

If you tried the supplied code how come you said you tried it with one block? The supplied code has two and i thought we established rng3 should have been rng4 in the second block. If you run the supplied code does it do as expected? If you need help you need to help me to help!

 

[SUSAN BAXTER]

To clarify I entered cell locations Set rng1 = Range("C9:H16") 'and Set rng2 = Range("C18:H25") and Set rng3 = Range("P15:S22") ' Set rng4 = Range("P24:S31") but I only test data in rng3 ("P15:S22") . I didn't have test data in rng4 ("P24:S31") .

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

Ok try this. It may work. It may not though as i cant test so run it on a copy workbook.

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
 
Application.ScreenUpdating = False

With ActiveSheet
    'create arrays
    arr1 = Array(.Range("D22:I36"), .Range("J22:O36"), .Range("P22:U36"), .Range("V22:AA36"), .Range("AB22:AG36") _
        , .Range("AH22:AM36"), .Range("AN22:AS36"), .Range("AT22:AY36"), .Range("AZ22:BE36"), .Range("BF22:BK36"))
    arr2 = Array(.Range("BN22:BQ36"), .Range("BR22:BU36"), .Range("BV22:BY36"), .Range("BZ22:CC36"), .Range("CD22:CG36") _
        , .Range("CH22:CK36"), .Range("CL22:CO36"), .Range("CP22:CS36"), .Range("CT22:CW36"), .Range("CY22:DA36"))                                                                '
    'loop through arrays
    For i = LBound(arr1) To UBound(arr1)
        Set rng1 = arr1(i)
        Set rng3 = arr2(i)                                                          '
        last1 = .Cells(.Rows.Count, ColLetter(rng1.Columns(1).Column)).End(xlUp).Row
        last2 = .Cells(.Rows.Count, ColLetter(rng3.Columns(1).Column)).End(xlUp).Row
 
        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
    Next
End With

Application.ScreenUpdating = True
 
End Sub
 
Function ColLetter(Collet As Integer) As String

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

End Function

 

[SUSAN BAXTER]

Thank-you, I will have to test and get back to you on Friday.

 

[James006]

Let's summarize the way you have ' organized ' your worksheet ..

1. Ten Data Blocks starting in Column D, with a width of 5 columns, a height of 15 rows, and a step of 6 to get to the next range

2. Then 8 empty columns before your 10 Reference Blocks

3. Each Reference Block has a width of 5 Columns, a height of 15 rows, with a step of 4 to get to the next range

4. Talking about the Pairs you need to compare ( i.e. rng 1 with rng 11, rng 2 with rng 12, etc ... )

the Offset starts at 62 for the first pair, and decreases by 2 for each following pair ...

with the exception of rng 20 located in column CY ... and which should logically be located in column CX

Could you share your comments ...

 

[SUSAN BAXTER]

@James006

Thank-you for your reply but I now have it solved.

 

[SUSAN BAXTER]

@steve the fish

It works, it works!! I’m very grateful for all your help.
I’m so excited, this is going to save me so much time. I think the appropriate saying in the UK is “your a star”!!!
<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>