For Each Loop

[jbjtc]

Helo, can anyone help with this query:

Is it possible to create a "For Each" loop that can copy two columns
sequentially one after the other, and after each copy, call a macro,
then copy the results given from the macro into different cells after
each iteration ?


To let you know, my columns contain cutting lists, which I have to
copy to a cell location, then call a "bin-packing algorithm" for each
cutting list. Then the result of each iteration must be saved to
separate cell locations.

I want to be able to run this "loop" based on the number of pairs of
columns with data in them which I have to copy(as the number of pairs
of columns will change all the time).

Any info/pointers you could give me would be of great assistance to
me.
Thank you.

 

[JLatham]

I think we need a little "before and after" example to make sure we
understand what you're after. Short example with maybe just 4 or 5 entries
in each column.

Also, need to know if the columns are right next to one another or not -
giving column letter names for them will really help.

I presume that you know that the list will always start on a particular row,
you just don't know where it will end? And that if there aren't values in
both of the 1st 2 rows involved, then don't copy either?

Here's some code to get you started - assumes columns are right next to one
another and we will loop through the shorter of the two, since once one ends,
there can't be any pairs beyond that point. Data presumed to be in columns A
and B.

Dim lastRow As Long
Dim myLoop As Long
Dim pairsFound as Long

lastRow = Range("A" & Rows.Count).End(xlUp).Row
If Range("B" & Rows.Count).End(xlUp).Row < lastRow Then
lastRow = Range("B" & Rows.Count).End(xlUp).Row
End If
'assumes data starts on row 2
For myLoop = 2 to lastRow
If Not IsEmpty(Range("A" & myLoop)) And _
Not IsEmpty(Range("B" & myLoop)) Then
pairsFound = pairsFound + 1
'code to copy/move the two values here
End If
Next
'now all of the pairs have been copied/moved somewhere
'continue processing. pairsFound has number of pairs copied.

This could be made more efficient, but this will work and how it works is
fairly visible. Hope this helps get you started.

 

[jbjtc]

Thanks for your reply.

To let you understand, I've included a snippet of the code which I have to
run to produce the results I need:

Sub test()
'
' Copy Columns from "Master" sheet to "Optimizer" sheet
'

Sheets("Master").Select
Selection.CurrentRegion.Copy
Sheets("Optimizer").Range("M1").PasteSpecial Paste:=xlValues,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False

'
' Copy Cutting List to Optimizer Columns (A & B), then Optimize
'
Sheets("Optimizer").Select
'1 (Run the first Iteration)
Columns("M:N").Copy
Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Call optimizer ' This calls up the bin-packing algorithm
Range("D3").Copy 'This is where the results from the bin-packing
algorithm appear after each iteration.
Range("F2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False 'This is where the result from above is
saved
'2 (Run the second Iteration)
Columns("O").Copy
Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Call optimizer
Range("D3").Copy
Range("F3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
'3
Columns("Q:R").Copy
Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Call optimizer
Range("D3").Copy
Range("F4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
'4
Columns("S:T").Copy
Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Call optimizer
Range("D3").Copy
Range("F5").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
'5
Columns("U:V").Copy
Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Call optimizer
Range("D3").Copy
Range("F6").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

' These iterations are repeated until all pairs of columns from M:N to
IU:IV have been utilised. (122 iterations)

End Sub

What I'm trying to achieve is to run a copy loop which will copy columns two
at a time (based on the number of columns with data in them, starting at
columns M & N), copy these columns to location (columns A & B), run the
optimizer macro, then copy the result sequentially to cells F2, F3, F4, F5
etc..

I have just included the first 5 or so iterations, but to let you know, the
number of columns that are copied into the spreadsheet varies (new cutting
lists for different jobs etc.). i.e I may need to copy just four columns (in
2 pairs, one after the other), or I may have to copy 50 columns etc.. The
column headings for each pair of columns is always:
No. of Pieces Cut Length (mm).

In short, I'm just trying to create a loop to do the above, based on the
number of columns with data in them, rather than do it a fixed number of
times (122 iterations, which slows the process down).

I hope this is enough info, if you need more details, please get back in
touch.

Thanks again

 

[JLatham]

A couple of questions:
#1 - what row are the headers "No. of Pieces" and "Cut Length (mm)." in?
#2 - do the header entries end when the data ends, or is it possible for the
headers to still be in place but without any data below them? If so, where
(what row) would need to be examined to determine there isn't any data
associated with the pair?

In other words, I'm trying to figure out how we tell the loop to end at the
earliest possible valid point.

 

[jbjtc]

The Column headings are constant at the top of each column (M1:N1). Any
number of pairs of columns can be copied starting from the location (M1:N1).
There will always be data returned in columns (there will be no blanks
between each row) that have these headings. When there is no data returned,
the entire column is blank (with no column headings). Here is an example of a
cutting list that would appear in columns (M:N) & (O):

No. of Pieces Cut Length (mm). No. of Pieces
Cut Length (mm).
3 762 6
333
4 605 9
444
10 905 17
567
15 1855 2
899
9 306 11
455
12 154 14
177

So what i need is to copy columns M:N (the entire range, M1:N65536), copy it
to location A1:B65536, (this is always the location for each paste special),
then call macro "Optimizer". This will return the optimized value to cell D3.
Then I need to copy
this value to cell F2. Then i need to repeat (loop) this process for columns
(O), but returning the optimized result to cell F3 and so on. I need to be
able to loop this code for any given number of pairs of columns with data in
them (starting from (M1:N1)).

There will never be column headings returned with no data under them.
The column headings are constant and are always at the first cell location
of each column. (M1:N1) (O) etc.

Thanks again.

 

[jbjtc]

Apologies if my cutting list example hasn't turned out correctly in the reply
window pane. Just to say the data has no spaces between them and that they
are the same size in each pair of columns.

 

[JLatham]

Copy this code into a module in a copy of the workbook (hate to destroy your
data due to some oversight on my part) and give it a test or two.

Sub MoveAndOptimize()
Dim rowOffset As Long
Dim colOffset As Long
Dim colsToCopy As String

Sheets("Master").Select
Range("M1").Select
Selection.CurrentRegion.Copy
Sheets("Optimizer").Range("M1").PasteSpecial Paste:=xlValues, _
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Sheets("Optimizer").Select


colOffset = 12 ' initilize to point at column M (1 + 12=13)
rowOffset = 2 ' first row in F to move data to
'prevent screen flicker and speed up processing
Application.ScreenUpdating = False
'begin looping until entry in row 1 is empty
Do While Not IsEmpty(Range("A1").Offset(0, colOffset))
colsToCopy = Range("A1").Offset(0, colOffset).Address & _
":" & Range("A1").Offset(Rows.Count - 1, colOffset + 1).Address

Columns(colsToCopy).Copy
Range("A1").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Call Optimizer ' This calls up the bin-packing algorithm
Range("F" & rowOffset).Value = Range("D3").Value
Application.CutCopyMode = False
colOffset = colOffset + 2 ' move over 2 columns
rowOffset = rowOffset + 1 ' down 1 row in col F
Loop ' continue looping until empty cell in row 1
Application.ScreenUpdating = True
End Sub

 

[jbjtc]

Just to say the code you have sent me (with a couple of tweaks) has worked an
absolute gem.
Thanks ever so much for your help.
My macro runs in seconds now as opposed to minutes!
From a very chuffed engineer.

 

[JLatham]

Thanks for the feedback. Glad to hear it's working properly.

"...seconds now as opposed to minutes!" --- of course you realize this now
removes some excuse for a longer coffee break while waiting for the results
<g>.