Trfing data from master wks to another wks

[Closed]
Report
Posts
5
Registration date
Wednesday February 4, 2015
Status
Member
Last seen
February 12, 2015
-
Posts
1320
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
October 8, 2021
-
Hi all...I would to get help from here as I trying to input my project data into my Master list. When we select won or lost under the status for project, the data will auto disappear and transfer to the Won list and Lost List. Anyone can advise me how to do?? Appreciate you all can help me.. thanks in advance for all the valuable input.. :)

13 replies

Posts
1320
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
October 8, 2021
239
Hello Kai,

I'm not sure if I have understood you correctly but the following code may be what you want:-
Sub TransferIt()
Application.ScreenUpdating = False
Dim lRow As Long
Sheets("Master").Select
lRow = Range("A" & Rows.Count).End(xlUp).Row

For Each Cell In Range("H2:H" & lRow)
    If Cell = "Won" Then
    Cell.EntireRow.Copy Sheets("Won").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    Cell.EntireRow.ClearContents
    ElseIf Cell = "Lost" Then
    Cell.EntireRow.Copy Sheets("Lost").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    Cell.EntireRow.ClearContents
    
End If
Next Cell

MsgBox "Data transfer completed!", vbExclamation
Range("A:G").Sort key1:=Range("A:A"), order1:=xlAscending, Header:=xlYes
Application.ScreenUpdating = True

End Sub


You can have a look at my test work book here:-

https://www.dropbox.com/s/negciuugs2zngli/Kai1404.xlsm?dl=0

Try it out and let us know if it works for you.

Kind regards,
vcoolio.
Posts
5
Registration date
Wednesday February 4, 2015
Status
Member
Last seen
February 12, 2015

Hi Vcoolio

Thanks for the reply.. But it seems like i have some error under this portion.


Range("A:S").Sort key1:=Range("A:A"), order1:=xlAscending, Header:=xlYes
Posts
1320
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
October 8, 2021
239
Hi Kai,

I have only guessed at how your work book is set out as there is not a lot of information in your original post. Could you please upload a sample of your work book but please be careful with sensitive data. You can upload using a file sharing site such as DropBox.

My test work book still works fine , even extending the range to ("A:S") so until I see a sample it is difficult to see what the problem is. Could you also please advise which error message is coming up.

In the meantime, comment out line 19 of the code by placing an apostrophe (') in front of it (this should make the font colour of the line change to green) and try the code without it.

Regards,
vcoolio.
Hi Vcoolio

Sorry for the late reply.

This is the link for my worksheet.
https://www.dropbox.com/s/ugdsennsxk13ofu/Project%20Pipline%20-%20Copy.xlsx?dl=0
Posts
1320
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
October 8, 2021
239
Hello Kai,

Try this amended code:-

Sub TransferIt()
Application.ScreenUpdating = False
Dim lRow As Long
Sheets("Pipeline").Select
lRow = Range("A" & Rows.Count).End(xlUp).Row

For Each Cell In Range("Q4:Q" & lRow)
    If Cell = "WON" Then
    Cell.EntireRow.Copy Sheets("Won").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    Cell.EntireRow.ClearContents
    ElseIf Cell = "LOST" Then
    Cell.EntireRow.Copy Sheets("Lost").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    Cell.EntireRow.ClearContents
End If
Next Cell

MsgBox "Data transfer completed!", vbExclamation
Range("A3:Q" & lRow).Sort key1:=Range("I3:I" & lRow), order1:=xlAscending, Header:=xlYes
Application.ScreenUpdating = True

End Sub


There were some discrepancies between the sheet tab names and the validation drop down contents. For example, you have WON, LOST etc. in upper case in the drop down but the sheet tab names have a capital and then lower case (Won, Lost). So the code did not reconcile between it and the sheet names. Also you don't have a sheet named "Master" but instead "Pipeline". The criteria (WON, LOST etc.) is in Column Q not Column H as per my guess.

The "sort" code now sorts on Column I, the estimated start month. It works ok now. However, you may prefer to sort on "Date" instead in Column A. This I will leave to you. Just change the reference in the code to "A3:A". The merged cells in the headings may cause a problem. If they do, unmerge them and re-format your headings without merging cells.

All the discrepancies have been accounted for in the above amended code, I think!

Kind regards,
vcoolio.
Hi Vcoolio

Thanks so much for your advise. Somehow it does not allow me to save the coding in my excel file. And i need your advise as well, the worksheet seems like will left a blanket in between when the won/no bid and lost is move to another worksheet. And once i move to another worksheet, i cannot move back the Pipeline worksheet. Any solution to it? Thanks in advance and sorry for asking so many qn..
Posts
1320
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
October 8, 2021
239
Hello Kai,

I just tried the code a number of times again in the test work book and your work book and all is working just fine. Could the problem actually be with your system?

Regards,
vcoolio.
hello vcoolio

You mean there shouldn't b blank when trf to the won worksheet? and we can move back the won project to Pipeline worksheet?

Sorry to ask.. am i suppose to save in a new module ?
Posts
1320
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
October 8, 2021
239
Hello Kai,

Yes, place the code in a new module. On the "Pipeline" sheet, create a button and assign the macro to it.

I have just tried the code again in your work book. There are no blanks and all entries go to the correct sheet, row by row. The code takes you back to the "Pipeline" sheet. It may be simplest to purge the worksheets and start again afresh (or create a new work book from scratch).

I'll be away for a few days but post back and let us know how it goes.
Regards,
vcoolio.
Hi Vcoolio

Thanks. I try again as my worksheet seems to be having alot of problem.
Posts
5
Registration date
Wednesday February 4, 2015
Status
Member
Last seen
February 12, 2015

Hi Vcoolio

I trying to use this code but it seems like giving me error. it keep showing me ActiveSheet.AutoFilter.ApplyFilter error.

XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

Private Sub Worksheet_Change(ByVal Target As Range)

ActiveSheet.AutoFilter.ApplyFilter

End Sub
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

Private Sub Worksheet_Calculate()

If Me.FilterMode = True Then
With Application
.EnableEvents = False
.ScreenUpdating = False
End With

With ActiveWorkbook
.CustomViews.Add ViewName:="Mine", RowColSettings:=True
Me.AutoFilterMode = False
.CustomViews("Mine").Show
.CustomViews("Mine").Delete
End With


With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End If

End Sub
Posts
2817
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
October 14, 2021
486
Hi Kai,

Vcoolio has asked me to see if I can help you out while he is away.

Change
ActiveSheet.AutoFilter.ApplyFilter
into
ActiveSheet.AutoFilter

And try again.

Let us know if further questions arise.

Best regards,
Trowa
Posts
5
Registration date
Wednesday February 4, 2015
Status
Member
Last seen
February 12, 2015

Hi Trowa

Firstly, thanks Vcoolio and urs help.. really appreciate it.

After i change, i still have this problem...

run time error '438'
object doesn't support this property or method
Posts
1320
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
October 8, 2021
239
Hello Kai,

I'm back! But not for long as I will be leaving tomorrow for another stint in the wilderness.

Just going back to the original code I gave you, here is an amended version for you:-
Sub TransferIt()
   Application.ScreenUpdating = False
Dim lRow As Long
     Sheets("Pipeline").Select
     lRow = Range("A" & Rows.Count).End(xlUp).Row

For Each Cell In Range("Q4:Q" & lRow)
    If Cell = "WON" Then
    Cell.EntireRow.Copy Sheets("Won").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    ElseIf Cell = "LOST" Then
    Cell.EntireRow.Copy Sheets("Lost").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
End If

Next Cell

MsgBox "Data transfer completed!", vbExclamation
  Sheets("Won").Range("A3:S" & Rows.Count).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10), Header:=xlYes
  Sheets("Lost").Range("A3:S" & Rows.Count).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10), Header:=xlYes
  Sheets("Pipeline").Range("A3:Q" & lRow).Sort key1:=Range("C3:C" & lRow), order1:=xlAscending, Header:=xlYes
  Application.ScreenUpdating = True

End Sub


This code should do what you want based on the criteria "WON" or "LOST".
Once you select "WON" from the drop down in Column Q, all rows of data with this criteria will be transferred to the "Won" sheet. The same will happen with the "LOST" criteria.

All data in the "Pipeline" sheet will remain intact with no blank rows anywhere.

You can have a look at the test work book here:-

https://www.dropbox.com/s/8igkwhgj9qvtsws/Kai1404%282%29.xlsm?dl=0

to see how it works.

Add some more fictitious data like I did, then click on the "Transfer Data" button to transfer the required data to the relevant sheet.

There should be no duplicate entries in the "Won' or "Lost" sheets with this code.

@ Trowa:-

Thanks for keeping an eye on the shop while I was away. Much appreciated.

Cheers Gentlemen,
vcoolio.