Excel VBA Macro to do this?

[Mike]

Hi everyone,

Say I have an excel spreadsheet model. The whole model is in a single record (from col A to col z for example). Some record cells have random number rand(). So I can run the model in 10, 100, 1000,… rows at the same time, every time I hit F9. Column “y” has an integer value (0,1,2,3,..), whilecolumn “z” is 0/1 always.

I want to write a macro that would:

1)Look at column “z”, if z=1, copy the whole record to a pre-defined area named “results”, say from col “aa” to col “az”.

2)The area named “results”, I want to sort it by column “ay” from smaller to larger.

Any neat smart piece of vba code that would do so would be greatly appreciated?

Thanks,

Mike

 

[Claus Busch]

Hi Mike,

Am Mon, 30 Dec 2013 15:22:36 -0800 (PST) schrieb Mike:

I want to write a macro that would:

1)Look at column ?z?, if z=1, copy the whole record to a pre-defined area named ?results?, say from col ?aa? to col ?az?.

2)The area named ?results?, I want to sort it by column ?ay? from smaller to larger.

try:

Sub Test()
Dim LRow As Long
Dim arrIn As Variant
Dim arrOut() As Variant
Dim myCount As Long
Dim i As Long, j As Long, k As Long

LRow = Cells(Rows.Count, "Z").End(xlUp).Row
arrIn = Range("Z1:Z" & LRow)
myCount = WorksheetFunction.CountIf(Range("Z1:Z" & LRow), 1)
ReDim Preserve arrOut(1 To myCount, 1 To 26)
k = 1
For i = 1 To LRow
If arrIn(i, 1) = 1 Then
For j = 1 To 26
arrOut(k, j) = Cells(i, j)
Next
k = k + 1
End If
Next
If Len(Range("AA1")) = 0 Then
Range("AA1").Resize(myCount, 26) = arrOut
Else
Cells(Rows.Count, "AA").End(xlUp)(2) _
.Resize(myCount, 26) = arrOut
End If
LRow = Cells(Rows.Count, "AA").End(xlUp).Row
Range("AA1:AZ" & LRow).Sort key1:=Range("AY1"), _
order1:=xlAscending, Header:=xlNo

End Sub


Regards
Claus B.

 

[Mike]

Hi everyone,



Say I have an excel spreadsheet model. The whole model is in a single record (from col A to col z for example). Some record cells have random numberrand(). So I can run the model in 10, 100, 1000,… rows at the same time,every time I hit F9. Column “y” has an integer value (0,1,2,3,..), while column “z” is 0/1 always.



I want to write a macro that would:



1)Look at column “z”, if z=1, copy the whole record to a pre-defined area named “results”, say from col “aa” to col “az”.



2)The area named “results”, I want to sort it by column “ay” fromsmaller to larger.



Any neat smart piece of vba code that would do so would be greatly appreciated?



Thanks,



Mike

Thanks Claus & Happy New 2014,
Mike

 

[Mike]

Hi everyone,



Say I have an excel spreadsheet model. The whole model is in a single record (from col A to col z for example). Some record cells have random numberrand(). So I can run the model in 10, 100, 1000,… rows at the same time,every time I hit F9. Column “y” has an integer value (0,1,2,3,..), while column “z” is 0/1 always.



I want to write a macro that would:



1)Look at column “z”, if z=1, copy the whole record to a pre-defined area named “results”, say from col “aa” to col “az”.



2)The area named “results”, I want to sort it by column “ay” fromsmaller to larger.



Any neat smart piece of vba code that would do so would be greatly appreciated?



Thanks,



Mike

Getting an error at this line: ReDim Preserve arrOut(1 To myCount, 1 To 26)?
Make it as ready to use as possible please...thanks

 

[Claus Busch]

Hi,

Am Tue, 31 Dec 2013 09:24:51 -0800 (PST) schrieb Mike:

Getting an error at this line: ReDim Preserve arrOut(1 To myCount, 1 To 26) ?
Make it as ready to use as possible please...thanks

you have to redim the array for max rows and max columns
myCount counts the 1 in range Z:Z, and 26 is A to Z

Look here:
https://skydrive.live.com/#cid=9378AAB6121822A3&id=9378AAB6121822A3!326
for workbook "Test".
Right click and download it and run macro "Test"


Regards
Claus B.

 

[Mike]

Hi,



Am Tue, 31 Dec 2013 09:24:51 -0800 (PST) schrieb Mike:







you have to redim the array for max rows and max columns

myCount counts the 1 in range Z:Z, and 26 is A to Z



Look here:

https://skydrive.live.com/#cid=9378AAB6121822A3&id=9378AAB6121822A3!326

for workbook "Test".

Right click and download it and run macro "Test"





Regards

Claus B.

--

Win XP PRof SP2 / Vista Ultimate SP2

Office 2003 SP2 /2007 Ultimate SP2

Working well, Thanks & Happy 2014

 

[Mike]

Hi,



Am Tue, 31 Dec 2013 09:24:51 -0800 (PST) schrieb Mike:







you have to redim the array for max rows and max columns

myCount counts the 1 in range Z:Z, and 26 is A to Z



Look here:

https://skydrive.live.com/#cid=9378AAB6121822A3&id=9378AAB6121822A3!326

for workbook "Test".

Right click and download it and run macro "Test"





Regards

Claus B.

--

Win XP PRof SP2 / Vista Ultimate SP2

Office 2003 SP2 /2007 Ultimate SP2

What I need to add to the code to do this: After it find a record with value=1 and move it to the other side, how do make sure the new record is not duplicated and if so remove duplication?

Thanks in advance...Mike

 

[Claus Busch]

Hi Mike,

Am Tue, 31 Dec 2013 10:59:07 -0800 (PST) schrieb Mike:

What I need to add to the code to do this: After it find a record with value=1 and move it to the other side, how do make sure the new record is not duplicated and if so remove duplication?

I hope you use xl2007 or newer.
Then change the last rows of the code to:

LRow = Cells(Rows.Count, "AA").End(xlUp).Row
With Range("AA1:AZ" & LRow)
.Sort key1:=Range("AY1"), order1:=xlAscending, Header:=xlNo
.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6 _
, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, _
20, 21, 22, 23, 24, 25, 26), Header:=xlNo
End With

Or look again for the workbook in SkyDrive


Regards
Claus B.

 

[Mike]

Hi Mike,



Am Tue, 31 Dec 2013 10:59:07 -0800 (PST) schrieb Mike:






I hope you use xl2007 or newer.

Then change the last rows of the code to:



LRow = Cells(Rows.Count, "AA").End(xlUp).Row

With Range("AA1:AZ" & LRow)

.Sort key1:=Range("AY1"), order1:=xlAscending, Header:=xlNo

.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6 _

, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, _

20, 21, 22, 23, 24, 25, 26), Header:=xlNo

End With



Or look again for the workbook in SkyDrive





Regards

Claus B.

--

Win XP PRof SP2 / Vista Ultimate SP2

Office 2003 SP2 /2007 Ultimate SP2

One more final please...
Say I want to have the code within a loop to run 20 times. Then, I want ever run to start with hitting "F9" button..... what else I need to add to the top of the code?

Thanks, Mike

 

[Claus Busch]

Hi Mike,

Am Thu, 2 Jan 2014 09:28:40 -0800 (PST) schrieb Mike:

Say I want to have the code within a loop to run 20 times. Then, I want ever run to start with hitting "F9" button..... what else I need to add to the top of the code?

put following code into the code module of the worksheet and switch
calculation to manual.
Right click on sheet tab => Show Code (every time you press F9 the code
runs):

Private Sub Worksheet_Calculate()
Dim LRow As Long
Dim arrIn As Variant
Dim arrOut() As Variant
Dim myCount As Long
Dim i As Long, j As Long, k As Long

Application.EnableEvents = False
LRow = Cells(Rows.Count, "Z").End(xlUp).Row
arrIn = Range("Z1:Z" & LRow)
myCount = WorksheetFunction.CountIf(Range("Z1:Z" & LRow), 1)
ReDim Preserve arrOut(1 To myCount, 1 To 26)
k = 1
For i = 1 To LRow
If arrIn(i, 1) = 1 Then
For j = 1 To 26
arrOut(k, j) = Cells(i, j)
Next
k = k + 1
End If
Next
If Len(Range("AA1")) = 0 Then
Range("AA1").Resize(myCount, 26) = arrOut
Else
Cells(Rows.Count, "AA").End(xlUp)(2) _
.Resize(myCount, 26) = arrOut
End If
LRow = Cells(Rows.Count, "AA").End(xlUp).Row
With Range("AA1:AZ" & LRow)
.Sort key1:=Range("AY1"), order1:=xlAscending, Header:=xlNo
.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6 _
, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, _
20, 21, 22, 23, 24, 25, 26), Header:=xlNo
End With
Application.EnableEvents = True
End Sub


Regards
Claus B.

 

[Mike]

Hi everyone,



Say I have an excel spreadsheet model. The whole model is in a single record (from col A to col z for example). Some record cells have random numberrand(). So I can run the model in 10, 100, 1000,… rows at the same time,every time I hit F9. Column “y” has an integer value (0,1,2,3,..), while column “z” is 0/1 always.



I want to write a macro that would:



1)Look at column “z”, if z=1, copy the whole record to a pre-defined area named “results”, say from col “aa” to col “az”.



2)The area named “results”, I want to sort it by column “ay” fromsmaller to larger.



Any neat smart piece of vba code that would do so would be greatly appreciated?



Thanks,



Mike

Sorry, I might have worded my question this time wrong. I want to have the code within a loop that would run it 20 times for example. That means the whole code would run 20 times, each time the whole code gets executed. Is your reply still valid? Thanks a lot...

 

[Claus Busch]

Hi Mike,

Am Thu, 2 Jan 2014 12:08:12 -0800 (PST) schrieb Mike:

Sorry, I might have worded my question this time wrong. I want to have the code within a loop that would run it 20 times for example. That means the whole code would run 20 times, each time the whole code gets executed. Is your reply still valid? Thanks a lot...

I don't really understand your question.
It doesn't make sense to run the code 20 times without calculation. You
get 20 times the same result and 19 of the duplicates will be deleted.
So you have the same output as running the code only once.
Now the code runs when you press F9.


Regards
Claus B.

 

[Claus Busch]

Hi Mike,

Am Fri, 3 Jan 2014 07:27:50 +0100 schrieb Claus Busch:

I don't really understand your question.
It doesn't make sense to run the code 20 times without calculation.

if your calculation is automatic then try:

Sub Test()
Dim LRow As Long
Dim arrIn As Variant
Dim arrOut() As Variant
Dim myCount As Long
Dim i As Long, j As Long, k As Long
Dim n As Long

Application.ScreenUpdating = False
Do
LRow = Cells(Rows.Count, "Z").End(xlUp).Row
arrIn = Range("Z1:Z" & LRow)
myCount = WorksheetFunction.CountIf(Range("Z1:Z" & LRow), 1)
ReDim Preserve arrOut(1 To myCount, 1 To 26)
k = 1
For i = 1 To LRow
If arrIn(i, 1) = 1 Then
For j = 1 To 26
arrOut(k, j) = Cells(i, j)
Next
k = k + 1
End If
Next
If Len(Range("AA1")) = 0 Then
Range("AA1").Resize(myCount, 26) = arrOut
Else
Cells(Rows.Count, "AA").End(xlUp)(2) _
.Resize(myCount, 26) = arrOut
End If
n = n + 1
Loop While n < =20

LRow = Cells(Rows.Count, "AA").End(xlUp).Row
With Range("AA1:AZ" & LRow)
.Sort key1:=Range("AY1"), order1:=xlAscending, Header:=xlNo
.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6 _
, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, _
20, 21, 22, 23, 24, 25, 26), Header:=xlNo
End With

Application.ScreenUpdating = True
End Sub

Or look again for the workbook at SkyDrive


Regards
Claus B.

 

[Mike]

Hi everyone,



Say I have an excel spreadsheet model. The whole model is in a single record (from col A to col z for example). Some record cells have random numberrand(). So I can run the model in 10, 100, 1000,… rows at the same time,every time I hit F9. Column “y” has an integer value (0,1,2,3,..), while column “z” is 0/1 always.

Hi Claus, can I have that macro in more than one sheet of one workbook? Each will have different range!

 

[Claus Busch]

Hi Mike,

Am Fri, 10 Jan 2014 06:31:43 -0800 (PST) schrieb Mike:

Hi Claus, can I have that macro in more than one sheet of one workbook? Each will have different range!

here the code for Sheet1, Sheet2 and Sheet4. You can modify the code by
changing arrSh

Sub Test()
Dim LRow As Long
Dim arrIn As Variant
Dim arrOut() As Variant
Dim myCount As Long
Dim i As Long, j As Long, k As Long
Dim m As Long, n As Long
Dim arrSh As Variant

Application.ScreenUpdating = False
arrSh = Array("Sheet1", "Sheet2", "Sheet4")
For m = LBound(arrSh) To UBound(arrSh)
n = 0
With Sheets(arrSh(m))
Do
LRow = .Cells(.Rows.Count, "Z").End(xlUp).Row
arrIn = .Range("Z1:Z" & LRow)
myCount = WorksheetFunction.CountIf(.Range("Z1:Z" & LRow), 1)
ReDim arrOut(1 To myCount, 1 To 26)
k = 1
For i = 1 To LRow
If arrIn(i, 1) = 1 Then
For j = 1 To 26
arrOut(k, j) = Cells(i, j)
Next
k = k + 1
End If
Next
If Len(.Range("AA1")) = 0 Then
.Range("AA1").Resize(myCount, 26) = arrOut
Else
.Cells(.Rows.Count, "AA").End(xlUp)(2) _
.Resize(myCount, 26) = arrOut
End If
n = n + 1
Loop While n <= 20
Application.Goto Sheets(arrSh(m)).Range("A1")
LRow = .Cells(.Rows.Count, "AA").End(xlUp).Row
With .Range("AA1:AZ" & LRow)
.Sort key1:=Range("AY1"), order1:=xlAscending, Header:=xlNo
.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6 _
, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, _
20, 21, 22, 23, 24, 25, 26), Header:=xlNo
End With
End With
Next
Application.ScreenUpdating = True
End Sub


Regards
Claus B.

 

[Mike]

Hi everyone,



Say I have an excel spreadsheet model. The whole model is in a single record (from col A to col z for example). Some record cells have random numberrand(). So I can run the model in 10, 100, 1000,… rows at the same time,every time I hit F9. Column “y” has an integer value (0,1,2,3,..), while column “z” is 0/1 always.

Fine, but I have different ranges on each sheet? You are assuming I always have 26, right?

 

[Claus Busch]

Hi Mike,

Am Fri, 10 Jan 2014 07:40:39 -0800 (PST) schrieb Mike:

Fine, but I have different ranges on each sheet? You are assuming I always have 26, right?

I thought different count of rows and always 26 columns.
If the columns are also different where should the output go? Always one
column right of the table?
I don't know if I can answer you before tomorrow.


Regards
Claus B.

 

[Mike]

Hi Mike,



Am Fri, 10 Jan 2014 07:40:39 -0800 (PST) schrieb Mike:

Tomorrow is fine. No of columns is always different from one sheet to another. I can create different one-sheet workbooks if no way found. All have same structure except some are wider than others...

 

[Claus Busch]

Hi Mike

Am Fri, 10 Jan 2014 07:51:30 -0800 (PST) schrieb Mike:

Tomorrow is fine. No of columns is always different from one sheet to another. I can create different one-sheet workbooks if no way found. All have same structure except some are wider than others...

try:

Sub Test()
Dim LRow As Long
Dim LCol As Long
Dim arrIn As Variant
Dim arrOut() As Variant
Dim myCount As Long
Dim i As Long, j As Long, k As Long
Dim m As Long, n As Long
Dim arrSh As Variant

Application.ScreenUpdating = False
arrSh = Array("Sheet1", "Sheet2", "Sheet4")

For m = LBound(arrSh) To UBound(arrSh)
With Sheets(arrSh(m))
LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
LCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
n = 0
Do
arrIn = .Range(.Cells(1, LCol), .Cells(LRow, LCol))
myCount = WorksheetFunction.CountIf(.Range(.Cells(1, LCol), _
.Cells(LRow, LCol)), 1)
ReDim arrOut(1 To myCount, 1 To LCol)
k = 1
For i = 1 To LRow
If arrIn(i, 1) = 1 Then
For j = 1 To LCol
arrOut(k, j) = .Cells(i, j)
Next
k = k + 1
End If
Next
Application.Goto Sheets(arrSh(m)).Range("A1")
If Len(.Cells(1, LCol + 1)) = 0 Then
.Cells(1, LCol + 1).Resize(myCount, LCol) = arrOut
Else
.Cells(.Rows.Count, LCol + 1).End(xlUp)(2) _
.Resize(myCount, LCol) = arrOut
End If
n = n + 1
Loop While n <= 20

LRow = .Cells(.Rows.Count, LCol + 1).End(xlUp).Row
With .Range(.Cells(1, LCol + 1), .Cells(LRow, 2 * LCol))
.Sort key1:=Cells(1, 2 * LCol - 1), order1:=xlAscending,
Header:=xlNo
.RemoveDuplicates
End With
End With
Next
Application.ScreenUpdating = True
End Sub

Or look again in SkyDrive for "Test"


Regards
Claus B.

 

[Mike]

Hi everyone,



Say I have an excel spreadsheet model. The whole model is in a single record (from col A to col z for example). Some record cells have random numberrand(). So I can run the model in 10, 100, 1000,… rows at the same time,every time I hit F9. Column “y” has an integer value (0,1,2,3,..), while column “z” is 0/1 always.

Getting syntax error in this:
..Sort key1:=Cells(1, 2 * LCol - 1), order1:=xlAscending,
Header:=xlNo