Simple VBA range loop?

[fedude]

I have two liked size ranges. 10 rows x 14 columns. I need to write a loop
routine that examines each cell in the 1st range and if it finds a "1", then
copy the contents of a static cell into the corresponding cell in the second
range.

This seems pretty straightforward, but I'm not getting anywhere (Obviously
I'm a newbie).

TIA

 

[David]

Hi,

You need to be a little more specific. Find the 1 and put it at the end of
your second range, just the 1 or the contents of the row, where the 1 is
found? You say "contents of a static cell", then maybe just one variable?

Both ranges are exactly the same size with a one to one correspondance
between the ranges, but they do not contain the same contents or you would
arlread have a 1 in the second range?

David

 

[fedude]

Sorry... noob you know.

Two exact sized ranges 10x14. One range (1st) is completely empty, the
second range has ones or zeros in every cell. The loop needs to examine
the contents of every cell in the 2nd range (ones and zeros) and if it finds
a "1" in a cell, the loop should copy the contents of a single independent
cell to the corresponding cell in the 1st array. The single independent
cell to copy contains an image in it and this same image will be copied to
every corresponding cell in the 1st array if the 2nd arrya has a "1" in it.

Does this help??

 

[JE McGimpsey]

One way:

Dim vStatic As Variant
Dim rDest As Range
Dim i As Long

vStatic = Range("Z100").Value 'Change to suit
With Range("A1").Resize(10, 14)
Set rDest = Range("A20").Resize(.Rows.Count, .Columns.Count)
For i = 1 To .Count
If IsNumeric(.Cells(i).Value) Then _
If .Cells(i).Value = 1 Then rDest(i).Value = vStatic
Next i
End With

 

[JE McGimpsey]

Oops, my previous post had you right up to the "contains an image".

Cells don't contain images - they can contain only values and formulae.

Images reside on the drawing layer "above" the cells.

So perhaps something like:

Dim picPicture As Picture
Dim picNew As Picture
Dim rDest As Range
Dim i As Long

Application.ScreenUpdating = False

Set picPicture = ActiveSheet.Pictures("Picture 1")

With Range("A1").Resize(10, 20)
Set rDest = Range("A20").Resize(.Rows.Count, .Columns.Count)
For i = 1 To .Count
If IsNumeric(.Cells(i).Value) Then
If .Cells(i).Value = 1 Then
Set picNew = picPicture.Duplicate
With rDest(i)
picNew.Top = .Top
picNew.Left = .Left
picNew.Height = .Height
picNew.Width = .Width
picNew.Placement = xlMoveAndSize
End With
End If
End If
Next i
End With

Application.ScreenUpdating = True

 

[fedude]

ARGH! Not knowing that about the pictures is what has been killing me.
Thanks for the knowledge. Impressive.

This works beautifully. Mucho thanks!

Just for my own information, can you explain what this part of the code is
doing:

picNew.Top = .Top
picNew.Left = .Left
picNew.Height = .Height
picNew.Width = .Width

 

[JE McGimpsey]

It resizes the new picture (picNew) to the size of the destination cell.

May be overkill if all your cells are the same size, but allows for
varying sized rows/columns.