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>

 

[James006]

Hi,

Have you had a chance to take at the solution provided at Ozgrid :

https://www.ozgrid.com/forum/forum/...macros/1216315-code-to-write-numbers-to-cells

 

[SUSAN BAXTER]

Hi James006

I have looked at the Ozgrid post and it's close but they have a box on the Excel sheet to "place the number" which I can't use in my code.

Thanks for the possible solution though.

 

[James006]

Hi,


When you say

... but they have a box on the Excel sheet ...

What do you mean by a Box .. ???

 

[SUSAN BAXTER]

James, is it possible to just take on a section of the code out for what I need. I could copy and post it here. Do you have any time to take a look?

 

[James006]

No problem ...

Do not know how large is the code ...

But it is always better to post the whole code ... and indicate which section needs to be modified ...

 

[SUSAN BAXTER]

Here is the whole code. I have not inserted my data block locations from my Excel sheet sample. In the Excel sheet it has a spot labelled “place numbers”. I do not require this action/section of the code. Thanks so much for looking at it and hopefully we can use it.
Susan

Rem Attribute VBA_ModuleType=VBAModule

 Option VBASupport 1
 Option Explicit
 

 
 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
 

 
       ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
       ' MAKE SURE TO ADJUST THE FOUR RANGES ADDRESSES TO BE IN LINE WITH THE WORKSHEET '
       ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 

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

 

[James006]

Thanks for the code ...

Understand you have created a Named range : "Place_Numbers"

Can you explain which Range this Named range represents ?

 

[SUSAN BAXTER]

Hi
I don’t know what they were doing. My understanding is that “named range” has to be deleted from the code.
<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>

 

[James006]

Hi again,

The code you posted does not use any Named range ...

Which section of this code do you need to modify ...???