Array macro question

  • Thread starter Thread starter L. Howard
  • Start date Start date
L

L. Howard

If I change this code (by Claus in a recent post):

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
Dim arrOut As Variant

If Intersect(Target, Sh.Range("F:F")) Is Nothing Or Sh.Name _
= "Shipped" Or Target.Count > 1 Then Exit Sub
With Target
If .Value = "Shipped" Then
arrOut = Range(Cells(.Row, 1), Cells(.Row, 7))
Sheets("Shipped").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) _
.Resize(1, 7) = arrOut
Rows(.Row).Delete
End If
End With
End Sub


To this, so as NOT to have an Event Macro:

Sub Array_Out()

Dim arrOut As Variant
Dim c As Range

For Each c In Range("F:F")

If c.Value = "This" Then

arrOut = Range(Cells(c.Row, 1), Cells(c.Row, 7))
Sheets("Shipped").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) _
.Resize(1, 7) = arrOut
'Rows(.Row).Delete

End If

Next

End Sub


Did I ruin the whole concept of the arrOut by doing a For Each c In Range("F:F")?

It works, and is fast, but it is dealing with a small amount of data.

Thanks,
Howard
 
If I change this code (by Claus in a recent post):



Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As

Range)

Dim arrOut As Variant



If Intersect(Target, Sh.Range("F:F")) Is Nothing Or Sh.Name _

= "Shipped" Or Target.Count > 1 Then Exit Sub

With Target

If .Value = "Shipped" Then

arrOut = Range(Cells(.Row, 1), Cells(.Row, 7))

Sheets("Shipped").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) _

.Resize(1, 7) = arrOut

Rows(.Row).Delete

End If

End With

End Sub





To this, so as NOT to have an Event Macro:



Sub Array_Out()



Dim arrOut As Variant

Dim c As Range



For Each c In Range("F:F")



If c.Value = "This" Then



arrOut = Range(Cells(c.Row, 1), Cells(c.Row, 7))

Sheets("Shipped").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) _

.Resize(1, 7) = arrOut

'Rows(.Row).Delete



End If



Next



End Sub





Did I ruin the whole concept of the arrOut by doing a For Each c In Range("F:F")?



It works, and is fast, but it is dealing with a small amount of data.



Thanks,

Howard
Click to expand...



I changed the range to this, instead of entire column F:

For Each c In Range("F1:F" & Cells(Rows.Count, "F").End(xlUp).Row)

Howard
 
Hi Howard,

Am Fri, 26 Sep 2014 08:45:22 -0700 (PDT) schrieb L. Howard:
I changed the range to this, instead of entire column F:

For Each c In Range("F1:F" & Cells(Rows.Count, "F").End(xlUp).Row)
Click to expand...

try FIND method and read all matches in the array:

Sub Array_Out()
Dim arrOut() As Variant
Dim c As Range
Dim rngBig As Range
Dim FirstAddress As String
Dim i As Long, n As Long, myCnt As Long

Set c = Range("F:F").Find("This", LookIn:=xlValues)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
myCnt = WorksheetFunction.CountIf(Range("F:F"), "This")
ReDim Preserve arrOut(myCnt - 1, 6)
For i = 0 To 6
arrOut(n, i) = Cells(c.Row, i + 1)
Next
n = n + 1
Set c = Range("F:F").FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If

Sheets("Shipped").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) _
.Resize(UBound(arrOut) + 1, 7) = arrOut
'Rows(.Row).Delete
End Sub


Regards
Claus B.
 
Hi again,

Am Fri, 26 Sep 2014 18:32:25 +0200 schrieb Claus Busch:
myCnt = WorksheetFunction.CountIf(Range("F:F"), "This")
ReDim Preserve arrOut(myCnt - 1, 6)
Click to expand...

write the redim statement out of the loop:

Sub Array_Out()
Dim arrOut() As Variant
Dim c As Range
Dim rngBig As Range
Dim FirstAddress As String
Dim i As Long, n As Long, myCnt As Long

Set c = Range("F:F").Find("This", LookIn:=xlValues)
myCnt = WorksheetFunction.CountIf(Range("F:F"), "This")
ReDim Preserve arrOut(myCnt - 1, 6)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
For i = 0 To 6
arrOut(n, i) = Cells(c.Row, i + 1)
Next
n = n + 1
Set c = Range("F:F").FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If

Sheets("Shipped").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) _
.Resize(UBound(arrOut) + 1, 7) = arrOut
'Rows(.Row).Delete
End Sub


Regards
Claus B.
 
Hi again,



Am Fri, 26 Sep 2014 18:32:25 +0200 schrieb Claus Busch:







write the redim statement out of the loop:



Sub Array_Out()

Dim arrOut() As Variant

Dim c As Range

Dim rngBig As Range

Dim FirstAddress As String

Dim i As Long, n As Long, myCnt As Long



Set c = Range("F:F").Find("This", LookIn:=xlValues)

myCnt = WorksheetFunction.CountIf(Range("F:F"), "This")

ReDim Preserve arrOut(myCnt - 1, 6)

If Not c Is Nothing Then

FirstAddress = c.Address

Do

For i = 0 To 6

arrOut(n, i) = Cells(c.Row, i + 1)

Next

n = n + 1

Set c = Range("F:F").FindNext(c)

Loop While Not c Is Nothing And c.Address <> FirstAddress

End If



Sheets("Shipped").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) _

.Resize(UBound(arrOut) + 1, 7) = arrOut

'Rows(.Row).Delete

End Sub





Regards

Claus B.

--
Click to expand...


Okay, the FIND code does have a familiar ring to it.

Thanks, Claus.

Regards,
Howard
 
Back
Top