Fill Column According to 2 Criteria

[MachaMacha]

I have attached a screenshot of the desired output.

The table in a16:g22 tells me how many of each type according to industry code (b16:g16) and amount (a17:a20). I want this table to be reflected in column M like the bolded values shown below. For example, there are 4 industry code 1, $10mm assets; therefore, in cells m2:m5 there are 4 $10mm.

There are 8 industry code 1, $25mm assets. Therefore m:5:m12 all say $25mm.

I would like VBA code that can fill in column M for me. What I have started is below. Thanks for any responses!


Sub FillSub()
Dim myRange2 As Range
Dim myArray2 As Variant
With ActiveSheet
Set myRange2 = Range(.Range("b6"), .Range("g6").End(xlDown))
End With
myArray2 = myRange2.Value
k = 1
For k = 1 To Range("g21").Value
Range("k1").Offset(k, 0).Value = k
Next k
Range("k1").Value = "Asset Number"
Range("k1").Offset(0, 1).Value = "Industry Code"
Range("k1").Offset(0, 2).Value = "Amount $"
Worksheets("Sheet1").Range("A1:M500").Columns.AutoFit

For Each c In Worksheets("Sheet1").Range("k2:k80").Cells
If Abs(c.Value) < Range("g22").Value Then c.Offset(0, 1).Value = Range("g16").Value
Next
For Each c In Worksheets("Sheet1").Range("k2:k74").Cells
If Abs(c.Value) < Range("f22").Value Then c.Offset(0, 1).Value = Range("f16").Value
Next
For Each c In Worksheets("Sheet1").Range("k2:k74").Cells
If Abs(c.Value) < Range("e22").Value Then c.Offset(0, 1).Value = Range("e16").Value
Next

For Each c In Worksheets("Sheet1").Range("k2:k74").Cells
If Abs(c.Value) < Range("d22").Value Then c.Offset(0, 1).Value = Range("d16").Value
Next

For Each c In Worksheets("Sheet1").Range("k2:k74").Cells
If Abs(c.Value) < Range("c22").Value Then c.Offset(0, 1).Value = Range("c16").Value
Next

For Each c In Worksheets("Sheet1").Range("k2:k74").Cells
If Abs(c.Value) < Range("b22").Value Then c.Offset(0, 1).Value = Range("b16").Value
Next

'Is there a way to condense all these For Each c lines into a smaller loop?
Dim myRange3 As Range
Dim myArray3 As Variant
With ActiveSheet
Set myRange3 = Range(.Range("k1"), .Range("m75").End(xlDown))
End With



Also, Is there a way to condense all these For Each c lines into a smaller loop? Any simpler solutions to what I have already written are much appreciated.

[p45cal]

Sub blah()
Dim myRng As Range
Range("K1") = "Asset Number": Range("L1") = "Industry Code": Range("M1") = "Amount $"
i = 1
For Each colmn In Range("$B$17:$F$20").Columns
For Each cll In colmn.Cells
For asset = 1 To cll.Value
Set myRng = Range("K" & i + 1) 'defines the range
myRng = i: i = i + 1 'puts a value in
myRng.Offset(, 1) = Cells(16, cll.Column)
myRng.Offset(, 2) = Cells(cll.Row, 1)
Next asset
Next cll
Next colmn
Range("A1:M1").Columns.AutoFit
End Sub

[JimmyTheHand]

Hi

The condensation of For..Each..Next loops can be done like this, I believe.

Sub Fill2()
Dim Wks As Worksheet
Dim Vert As Range, Horiz As Range, VHit As Range, HHit As Range
Dim Src As Range, c As Range


Set Wks = Worksheets("Sheet1")
Set Horiz = Wks.Range("B16:F16")
Set Vert = Wks.Range("A17:A20")

Intersect(Vert.EntireRow, Horiz.EntireColumn).ClearContents

Set Src = Wks.Range("k2")
Set Src = Range(Src, Src.End(xlDown))

For Each c In Src.Cells
Set VHit = Vert.Find(c.Offset(, 2), , , xlWhole)
Set HHit = Horiz.Find(c.Offset(, 1), , , xlWhole)
If (HHit Is Nothing) Or (VHit Is Nothing) Then
c.Interior.ColorIndex = 3
Else
Intersect(VHit.EntireRow, HHit.EntireColumn) = Intersect(VHit.EntireRow, HHit.EntireColumn) + 1
End If
Next c
End Sub
Jimmy

[p45cal]

tell us twice rather than not at all OK:

I would like VBA code that can fill in column M for me. I would like VBA code that can fill in column M for me.
teehee!..:thumb

[MachaMacha]

Thank you p45cal and JimmyTheHand! This was just what I was looking for.:cloud9:

[JimmyTheHand]

OK:

teehee!..:thumb
:wot

Seems like I was in such a hurry that I never read the question... Sorry :o:
Anyway, I've never seen syntax like this:

myRng = i: i = i + 1
Please explain it to me. What is that colon doing there? Thx

[david000]

It's a shortcut line continuation thing. Used to tightly group code. Very common in Select Case statments that have lots of options.
This swaps the values in range A1 & A2.

Sub ColonMe()
x = [a1].Value: y = [a1].Offset(, 1).Value: [a1] = y: [a1].Offset(, 1) = x
End Sub