For Each Loop
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" wrote:
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.
--
jj
"JLatham" wrote:
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" wrote:
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:P").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
--
jj
"JLatham" wrote:
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" wrote:
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.
--
jj
|