Create an array inside a For...Next loop

[Guest]

I will be looping through a dynamic range of cells, and when my condition is
met I want to add that value to an array, and then empty the contents of the
array onto a different spreadsheet. As a simple example:

'Adding item to array
For each cel in Range("A1:A100")
If cell.value = "X" Then
add cell value to my array
end
Next cell

'Writing data to new spreadsheet
For each cell in Range("B1:B100")
add array item to current cell
Next cell

Does anyone have any suggestions? Thanks in a advance!

 

[RB Smissaert]

Sub test()

Dim r As Long
Dim arr(1 To 100, 1 To 1) As String

For r = 1 To 100
If Cells(r, 1) = "X" Then
arr(r, 1) = "found"
End If
Next

Workbooks.Open Filename:="C:\Test.xls"

Sheets("Sheet2").Select

Range(Cells(2), Cells(100, 2)) = arr

End Sub


RBS

 

[Norman Jones]

Hi Eric,

Tyr something like:

'==============>>
Public Sub DeleteRange()

Dim Rng As Range
Dim rCell As Range
Dim copyRng As Range
Dim WB As Workbook
Dim SH As Worksheet
Dim destSH As Worksheet
Dim destRng As Range
Dim CalcMode As Long

Set WB = ActiveWorkbook '<<======== CHANGE
Set SH = WB.Sheets("Sheet1") ' <<======= CHANGE
Set Rng = SH.Range("A1:A100") '<<======= CHANGE
Set destSH = WB.Sheets("Sheet2") '<<======= CHANGE
Set destRng = destSH.Range("B2") '<<======= CHANGE

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

For Each rCell In Rng.Cells
If rCell.Value = "X" Then
If copyRng Is Nothing Then
Set copyRng = rCell
Else
Set copyRng = Union(rCell, copyRng)
End If
End If
Next rCell

If Not copyRng Is Nothing Then
copyRng.Copy Destination:=destRng
Else
'nothing found, do nothing
End If

With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With

End Sub
'==============>>

 

[Norman Jones]

Hi Eric,

Please ignore my response.

I mis-read your question!