transfering values onto a grid

  • Thread starter Thread starter Julie
  • Start date Start date
J

Julie

This problem has two parts that are very similar.
First Part:
I have data in the cells listed below:
A16=1 O16=.5 P16=2
A17=2 O17=.7 P17=3
A18=3 O18=.3 P18=1
A19=4 O19=.9 P19=4
A20=5 O20=.2 P20=3
A21=6 O21=.3 P21=1
etc

I want the number from the first column listed above to be put in the
intersecting cells of the next two columns where the 2nd column is on
the Y axis (1.0 - .1) and the 3rd column is on the X axis (1 - 10). See
example:

C210= 1.0
C211 = .9 4
C212= .8
C213= .7 2
C214= .6
C215= .5 1
C216= .4
C217= .3 3,6
C218= .2 5
C219= .1
D220=1 E220=2 F220=3 G220=4 H220=5 I220=6 J220=7 K220=8
L220=9
M220=10

Second Part:
This is the same only the X axis starts at -10 and goes to -1. It looks
like this:

A226=1 O226=.5 P226= -9
etc

C310= 1.0
C311 = .9
C312= .8
C313= .7
C314= .6
C315= .5 1
C316= .4
C317= .3
C318= .2
C319= .1
D320=-10 E320=-9 F320=-8 G320=-7 H320=-6 I320=-5 J320=-4
K320=-3 L320=-2 M320=-1

If there is more than one value in a cell, I would like them separated
by a comma. Any help you could give me would be really appreciated.

** Posted via: http://www.ozgrid.com
Excel Templates, Training, Add-ins & Software!
http://www.ozgrid.com/Services/excel-software-categories.htm **
 
After a couple of private emails, I think that this works (you do always type
positive numbers in column P, don't you.)

Option Explicit
Sub testme()

Dim myCell As Range
Dim myRngAddr As Variant
Dim myTableAddr As Variant
Dim myTable As Range
Dim myRng As Range

Dim iCtr As Long
Dim tCtr As Long

Dim resRow As Variant
Dim resCol As Variant

Dim myMultiplier As Variant

myTableAddr = Array("d210", "d292")
myRngAddr = Array("a16:A200", "a227:a282")
myMultiplier = Array(1, -1)

If UBound(myTableAddr) <> UBound(myRngAddr) _
Or UBound(myTableAddr) <> UBound(myMultiplier) Then
'all three should have the same number of elements
MsgBox "design error!"
Exit Sub
End If

With Worksheets("Risk Sev")
For tCtr = LBound(myRngAddr) To UBound(myRngAddr)
Set myTable = .Range(myTableAddr(tCtr))
myTable.Resize(10, 10).ClearContents

Set myRng = .Range(myRngAddr(tCtr))

For Each myCell In myRng.Cells
If Trim(myCell.Value) = "" Then
'do nothing
Else

resCol = Application.Match(myMultiplier(tCtr) * _
.Cells(myCell.Row, "p"), _
myTable.Offset(10, 0).Resize(1, 10), 0)
resRow = Application.Match(.Cells(myCell.Row, "o").Value, _
myTable.Offset(0, -1).Resize(10, 1), 0)

If IsError(resRow) _
Or IsError(resCol) Then
MsgBox "error with: " & myCell.Address(0, 0)
Else
If myTable.Offset(resRow - 1, resCol - 1).Value _
= "" Then
myTable.Offset(resRow - 1, resCol - 1).Value _
= "'" & myCell.Value
Else
myTable.Offset(resRow - 1, resCol - 1).Value _
= myTable.Offset(resRow - 1, resCol - 1).Value _
& "," & myCell.Value
End If
End If
End If
Next myCell
Next tCtr
End With

End Sub

If you actually enter positive and negative values in your data, then change
this line:

myMultiplier = Array(1, -1)
to
myMultiplier = Array(1, 1)

(It's just used to change the sign.)

And watchout for your data validation.
 
Back
Top