Is there a quicker way to do this loop (through sheets)

[JumboCactuar]

Hi

It looks through 5 sheets and copies data if criteria is met
CopyTo - is just to get the line no of last row + 1

Even with Application.ScreenUpdating off - its takes roughly 30 - 40 seconds which i feel is slow for this small loop
note that CopyFrom never exceeds 200

Sub DataMerge1()
Dim WS As Variant

Application.ScreenUpdating = False

Set CurrentWS = ThisWorkbook.Sheets("DataMerge")

CopyTo = CurrentWS.Range("A5000").End(xlUp).Row + 1

    For Each WS In Array(Sheet15, Sheet16, Sheet17, Sheet18, Sheet19)
    
CopyFrom = 2

'MONDAY
Do While WS.Cells(CopyFrom, 32) <> ""
If WS.Cells(CopyFrom, 56).Value > 0 Then
    CurrentWS.Cells(CopyTo, 2).Value = WS.Cells(CopyFrom, 32).Value
    CurrentWS.Cells(CopyTo, 3).Value = WS.Cells(CopyFrom, 33).Value
    CurrentWS.Cells(CopyTo, 4).Value = WS.Cells(CopyFrom, 54).Value
    CurrentWS.Cells(CopyTo, 5).Value = WS.Cells(CopyFrom, 55).Value
    CurrentWS.Cells(CopyTo, 6).Value = WS.Cells(CopyFrom, 56).Value
    CurrentWS.Cells(CopyTo, 7).Value = WS.Cells(CopyFrom, 58).Value
    CopyTo = CopyTo + 1
End If

CopyFrom = CopyFrom + 1

Loop

Next WS

Application.ScreenUpdating = True

End Sub

thanks

 

[Fazza]

for sure. simplest is to use some arrays. one array to record the result set and another (reuse each loop) for the contents of the source worksheets. loop through the source worksheet data in array & selectively copy wanted data to result set array, when looping done, write result set array to destination.

hard to give much more advice without knowing more about set up. cheers

 

[JumboCactuar]

for sure. simplest is to use some arrays. one array to record the result set and another (reuse each loop) for the contents of the source worksheets. loop through the source worksheet data in array & selectively copy wanted data to result set array, when looping done, write result set array to destination.

hard to give much more advice without knowing more about set up. cheers

Thanks, could you give me an example ive never used arrays

eg - source data = Sheet1.Range("A2:G1000")

copy values from Sheet1 columns B,C,D
to
sheet 2 columns A,B,C

if Sheet 1 column A value is greater than 0

 

[Fazza]

consider Speed up VBA Code - Use an array instead maybe?

 

[JumboCactuar]

thanks @Fazza

almost there, but probably a more elegant way to do this - working with what i understand for now

MyArr is the fixed range
MyArr2 is built from the criteria and local window shows this builds correctly

now just need to figure how to output MyArr2 to worksheet after each loop > after last row of DataMerge sheet

Sub DataMerge1()
Dim WS As Variant
Dim MyArr As Variant, MyArr2(1 To 500, 1 To 7) As Variant

Application.ScreenUpdating = False

Set CurrentWS = ThisWorkbook.Sheets("DataMerge")

    For Each WS In Array(Sheet15, Sheet16, Sheet17, Sheet18, Sheet19)
   
MyArr = WS.Range("AF6:BF500")

Row = 1
Row2 = 1
OutputLine = CurrentWS.Range("A5000").End(xlUp).Row + 1

'MONDAY
Do While MyArr(Row, 1) <> ""
Debug.Print MyArr(Row, 1)
If MyArr(Row, 25) > 0 Then
    MyArr2(Row2, 1) = CDbl(WS.Cells(1, 16))
    MyArr2(Row2, 2) = MyArr(Row, 1)
    MyArr2(Row2, 3) = MyArr(Row, 2)
    MyArr2(Row2, 4) = Round(MyArr(Row, 23), 4)
    MyArr2(Row2, 5) = Round(MyArr(Row, 24), 4)
    MyArr2(Row2, 6) = MyArr(Row, 25)
    MyArr2(Row2, 7) = Round(MyArr(Row, 27), 4)
    Row2 = Row2 + 1
End If

Row = Row + 1

Loop

Next WS

Application.ScreenUpdating = True

End Sub

 

[JumboCactuar]

Update - got this working and its much faster

Sub DataMerge1()
Dim WS As Variant
Dim MyArr As Variant, MyArr2(1 To 500, 1 To 7) As Variant

Application.ScreenUpdating = False

Set CurrentWS = ThisWorkbook.Sheets("DataMerge")

    For Each WS In Array(Sheet15, Sheet16, Sheet17, Sheet18, Sheet19)
    
MyArr = WS.Range("AF6:BF500")

Row = 1
Row2 = 1
OutputLine = CurrentWS.Range("A5000").End(xlUp).Row + 1

'MONDAY
Do While MyArr(Row, 1) <> ""
Debug.Print MyArr(Row, 1)
If MyArr(Row, 25) > 0 Then
    MyArr2(Row2, 1) = CDbl(WS.Cells(1, 16))
    MyArr2(Row2, 2) = MyArr(Row, 1)
    MyArr2(Row2, 3) = MyArr(Row, 2)
    MyArr2(Row2, 4) = Round(MyArr(Row, 23), 4)
    MyArr2(Row2, 5) = Round(MyArr(Row, 24), 4)
    MyArr2(Row2, 6) = MyArr(Row, 25)
    MyArr2(Row2, 7) = Round(MyArr(Row, 27), 4)
    Row2 = Row2 + 1
End If

Row = Row + 1

Loop

Set Destination = CurrentWS.Range("A" & OutputLine)
Destination.Resize(UBound(MyArr2, 1), UBound(MyArr2, 2)).Value = MyArr2

Erase MyArr2

Next WS

Application.ScreenUpdating = True

End Sub

Though can anyone explain this line -
Destination.Resize(UBound(MyArr2, 1), UBound(MyArr2, 2)).Value = MyArr2
it works but dont quite understand what is happening with (MyArr2, 1) + MyArr2, 2)

thanks

 

[Fazza]

WELL DONE. Great work. It should execute really quickly

MyArr2 is set to (1 to 500, 1 to 7)
its upper bound on the first part is 500, in VBA this is UBound(MyArr2, 1)
its upper bound on the second part 7, in VBA this is UBound(MyArr2, 2)

the destination cell in column A is being resized to 500 rows by 7 columns to receive the data.
instead of the 500, that could be Row2 - 1
because Row2 is one more than the number of rows of data loaded to MyArr2

using UBound like that line is the right way. Sometimes you see people instead write,
Destination.Resize(500, 7).Value = MyArr2
or Destination.Resize(iRow2 - 1, 7).Value = MyArr2
This could be a line amongst thousands, Then if the array changes to being (1 to 1000, 1 to 10) to cater for more data, their original line will still only get 500 rows and 7 columns - missing lots of data. This can go unnoticed & lead to problems. Always good practice is like you've got it using UBound

 

[JumboCactuar]

thanks @Fazza

theres one thing i can't figure out and not sure if it can be output in the same way
outputting just a single "column" of array to worksheet

as an example in the code above

    MyArr2(Row2, 3) = MyArr(Row, 2)

how could i output every element of MyArr2(Row2, 3) to a range

thinking i have to change this part somehow
Destination.Resize(UBound(MyArr2, 1), UBound(MyArr2, 2)).Value = MyArr2

i know the below outputs the first 3 columns

Destination.Resize(UBound(MyArr2, 1), 3).Value = MyArr2

but if i wanted to output just the 3rd column, can it be done this way?

thanks

 

[Fazza]

yes, here is a good explanation VBA Trick of the Week :: Slicing an Array Without Loop – Application.Index