• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Can any one suggest how to write a macro for this...

R

Rajasekhar

New Member
Hi all...

I Am Trying to write a Macro for doing this.. as i am new to macro's am unable to figure out how to do it.. Can any one please Help

Assume i have given the columns in Order Like IN is ColumnA Like dat...


InputData: (Sheet1)

IN OUT Item Unit Date Location

---------------------------------------------------------------------

AB XY Item1 No's 12-5-2013 IND

CD BV Item1 No's 12-5-2013 IND


ItemRouting:(Sheet2)

Item Routing

----------------------

Item1 Item1Route

Item2 Item2Route


Routing:(Sheet3)

Routing IN OUT RoutingSteps Department

------------------------------------------------------

Item1Route AB XY Step1 Procurement

Item1Route AB XY Step2 Selling

Item2Route CD BV Step1 Procurement

Item2Route CD BV Step2 Selling


From the above data

1. I Have to Select a Routing(From ItemRouting) based on Item (From InputData)

2. Based on the Routing Selected From Step1,IN,Out(From DataInput) select the Routingsteps,Department(From Routing)

3.Based on the Department Selected i Have to copy the details in that particular Department(Sheet)...


For the Above example the output will be:


Procurement(Sheet):

IN OUT Item Unit Date Location RoutingStep Department

--------------------------------------------------------------------------

AB XY Item1 N0's 12-5-2013 IND Step1 Procurement

CD BV Item1 N0's 12-5-2013 IND Step1 Procurement


Selling:


IN OUT Item Unit Date Location RoutingStep Department

--------------------------------------------------------------------------

AB XY Item1 N0's 12-5-2013 IND Step2 Selling

CD BV Item1 N0's 12-5-2013 IND Step2 Selling


Any Help will be Appreciated...

Thanks

Raj...
 
Raj


It may well be possible to do this without VBA at all


Can you post a sample file

Refer: http://chandoo.org/forums/topic/posting-a-sample-workbook
 
Thanks for the Reply Hui...

Please Refer the Sample File i Uploaded....I Have shown the output in the sample data...

I need it in macro only...


http://www.2shared.com/file/S75m6_X9/Sample.html
 
I Have Written this Code... i Think the Perfomance Can be Increased... Can any one Modify the code so that i executes Faster...

[pre]
Code: 
Sub CopyingMacro()

Dim DatainputRowCount As Long, ProductRoutingRowCount As Long, RoutingRowCount As Long, DRowcount As Long
Dim IpProductType As String, DataIN As String, DataOut As String, Routing As String, Department As String, RoutingStep As String

'Sheets("DataInput").Select
DatainputRowCount = Sheets("DataInput").Cells(Cells.Rows.Count, "E").End(xlUp).Row
For i = 2 To DatainputRowCount
Sheets("DataInput").Select
Range("E" & i).Select
IpProductType = Range("E" & i).Value
'ActiveCell
DataIN = Range("C" & i).Value
DataOut = Range("D" & i).Value
ActiveCell.EntireRow.Copy
Sheets("ProductRouting").Select
ProductRoutingRowCount = Cells(Cells.Rows.Count, "A").End(xlUp).Row

For pr = 2 To ProductRoutingRowCount
If Range("A" & pr).Value = IpProductType Then
Routing = Range("B" & pr).Value
pr = ProductRoutingRowCount
End If
Next

'Sheets("Routing").Select
RoutingRowCount = Sheets("Routing").Cells(Cells.Rows.Count, "A").End(xlUp).Row

For r = 2 To RoutingRowCount
Sheets("Routing").Select
If Range("A" & r).Value = Routing And Range("B" & r).Value = DataIN And Range("C" & r).Value = DataOut Then
RoutingStep = Range("D" & r).Value
Department = Range("E" & r).Value
Sheets(Department).Select
DRowcount = Cells(Cells.Rows.Count, "A").End(xlUp).Row
Range("A" & DRowcount + 1).Select
ActiveSheet.Paste
Range("O" & DRowcount + 1).Value = RoutingStep
Range("P" & DRowcount + 1).Value = Department

End If
Next
Next

End Sub
[/pre]
 
Hi, Rajasekhar!


Not tested, but give it a try:

-----

[pre]
Code: 
Option Explicit

Sub CopyingMacro()

Dim DataInputRowCount As Long, RoutingRowCount As Long, DRowCount As Long
Dim IpProductType As String, DataIN As String, DataOut As String, Routing As String, Department As String, RoutingStep As String
Dim I As Long, R As Long

Sheets("DataInput").Activate
DataInputRowCount = Cells(Cells.Rows.Count, 5).End(xlUp).Row

For I = 2 To DataInputRowCount
Sheets("DataInput").Activate
IpProductType = Cells(I, 5).Value
DataIN = Cells(I, 3).Value
DataOut = Cells(I, 4).Value
Rows(I).Copy

Routing = Columns(1).Find(IpProductType, , xlValues, xlWhole).Row

Sheets("Routing").Activate
RoutingRowCount = Cells(Cells.Rows.Count, 1).End(xlUp).Row

For R = 2 To RoutingRowCount
Sheets("Routing").Activate
If Cells(R, 1).Value = Routing And Cells(R, 2).Value = DataIN And Cells(R, 3).Value = DataOut Then
RoutingStep = Cells(R, 4).Value
Department = Cells(R, 5).Value
Sheets(Department).Activate
DRowCount = Cells(Cells.Rows.Count, 1).End(xlUp).Row
Cells(DRowCount + 1, 1).Paste
Cells(DRowCount + 1, 15).Value = RoutingStep
Cells(DRowCount + 1, 16).Value = Department

End If
Next
Next

End Sub
[/pre]
-----


The main idea is to avoid the use of .Select method and use .Find method to replace the 2nd loop.


Regards!
 
Hi SirJB7...

Thanks for the answer...

but i am getting.. Runtime Error '91'. Object Variable or with Block Variable not set...

i am getting this error at this line..

"Routing = Columns(1).Find(IpProductType, , xlValues, xlWhole).Row"...

i read that using vlookup and concatenate we can do this much faster... is it true...?


Thanks

Raj...
 
@SirJB7...

The macro which you Wrote Run Faster sir... i have made Some Changes to get rid of that error.... After making the changes this is the macro...

[pre]
Code: 
Option Explicit
Sub CopyingMacro()
Dim DataInputRowCount As Long, RoutingRowCount As Long, DRowCount As Long
Dim IpProductType As String, DataIN As String, DataOut As String, Routing As String, Department As String, RoutingStep As String
Dim I As Long, R As Long, Rowno As Long

Sheets("DataInput").Activate
DataInputRowCount = Cells(Cells.Rows.Count, 5).End(xlUp).Row

For I = 2 To DataInputRowCount
Sheets("DataInput").Activate
IpProductType = Cells(I, 5).Value
DataIN = Cells(I, 3).Value
DataOut = Cells(I, 4).Value
Rows(I).Copy

Rowno = Sheets("ProductRouting").Columns(1).Find(IpProductType, , xlValues, xlWhole).Row
Routing = Sheets("ProductRouting").Range("B" & Rowno).Value

Sheets("Routing").Activate
RoutingRowCount = Cells(Cells.Rows.Count, 1).End(xlUp).Row

For R = 2 To RoutingRowCount
Sheets("Routing").Activate
If Cells(R, 1).Value = Routing And Cells(R, 2).Value = DataIN And Cells(R, 3).Value = DataOut Then
RoutingStep = Cells(R, 4).Value
Department = Cells(R, 5).Value
Sheets(Department).Select
DRowCount = Cells(Cells.Rows.Count, 1).End(xlUp).Row
Range("A" & DRowCount + 1).Select
ActiveSheet.Paste
Range("O" & DRowCount + 1).Value = RoutingStep
Range("P" & DRowCount + 1).Value = Department

End If
Next
Next
End Sub
[/pre]

Sir Can u suggest any other way to increase the speed...
 
Hi, Rajasekhar!!

How much is it lasting and for how many records on each worksheet?

Regards!
 
Hi SirJB7!!

Right now am Testing with Sample data with twenty rows in all sheets it's taking 1-2 seconds.... In practical scenario there will be thousands of rows...
 
Hi Rajasekhar ,


One way to improve performance is to load all the data that is required , into arrays , and do all your processing using array elements ; use arrays to store the outputs , and then write all the output arrays to the respective worksheets.


If you can upload your workbook , I can help.


Narayan
 
Hi Narayan,

This is the link to the sheet..

http://www.2shared.com/file/S75m6_X9/Sample.html


One more enhancement.. if Column 'No' already exists in Department tables then no need to copy that one...Like in Input data Sheet there is '1' in column "No" for row 2... '1' is also present in Column "NO" for PATTERN Sheet so need to copy that Row from DATAINPUT Sheet to any other Sheet


Thanks

Raj
 
You must log in or register to reply here.
Back
Top