Need help with VBA, kind of complicated

[Julie]

Okay, I am having trouble writing a procedure. I have a list of risks
that are numbered 1- possibly 200. For each risk, a probability factor
is chosen out of the list (.1, .2, .3, .4, .5, .6, .7, .8, .9, 1.0) and
a consequence factor is chosen out of the list (1, 2, 3, 4, 5, 6, 7, 8,
9, 10). I have a grid below with the Y axis being the probability and
going from .1 to 1.0 and the X axis is the consequence going from 1to
10. I want the risk number to be placed in the correct box in the grid
and I want each box to contain as many numbers as possible. For example
if risk #1 has a probability factor of .3 and a consequence factor of 6,
I want a 1 in the box where .3 and 6 meet, and if #4 happens to have the
same probability and consequence factor value, I would like the box to
have 1,4 in it.
I would be very appreciative of any help I could get on this.
Thanks,
Julie

** Posted via: http://www.ozgrid.com
Excel Templates, Training, Add-ins &
Software!http://www.ozgrid.com/Services/excel-software-categories.htm **

 

[Dave Peterson]

I'm confused about the layout of your data and where your table is located and
the layout of the table. But other than those few things, I think that this'll
work!

I put my input data in A2:C200 (about) (header row in row 1)
I put my list in column A.
I put my probabilities (0.1 to 1.0) in column B.
I put my consequences (1 to 10) in column C.

The macro creates a new worksheet.
.1 to 1.0 gets put into B1:K1
1 to 10 gets put into A2:A11

Then it puts the data into that table.

If there's an error in the input range (say a probability of .15 or a
consequence of 11), then I stick an error in column D of that row. (Make sure
column D is empty before you start!)

Anyway, here's the code:

Option Explicit
Sub testme()

Dim myCell As Range
Dim myRng As Range
Dim myTable As Range
Dim iCtr As Long
Dim resRow As Variant
Dim resCol As Variant

With Worksheets.Add
For iCtr = 1 To 10
.Range("a1").Offset(iCtr, 0).Value = iCtr
.Range("a1").Offset(0, iCtr).Value = iCtr / 10
Next iCtr
Set myTable = .Range("A1").Resize(11, 11)
End With

With Worksheets("sheet1")
Set myRng = .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))
For Each myCell In myRng.Cells
resCol = Application.Match(myCell.Offset(0, 1).Value, _
myTable.Rows(1), 0)
resRow = Application.Match(myCell.Offset(0, 2).Value, _
myTable.Columns(1), 0)

If IsError(resRow) _
Or IsError(resCol) Then
myCell.Offset(0, 3).Value = "ERROR"
Else
If myTable(resRow, resCol).Value = "" Then
myTable(resRow, resCol).Value = "'" & myCell.Value
Else
myTable(resRow, resCol).Value _
= myTable(resRow, resCol).Value & "," & myCell.Value
End If
End If
Next myCell

End With

End Sub