none
Copy Cells Relevant to Unquie Col Match and Save to Local Drive RRS feed

  • Question

  • Hello, 

    I am new to VBA, and was going back and forth between the available codes trying to create VBA to execute the following, but was not able to get a complete one that get through end to end: 

    In my workbook Inventory, I have 4 worksheets (Source, Target, List_of_Admins, Instructions), and I populate the Source and List_of_Admins tabs from external workbook named customerWorkbook, and then would like to copy the results in Source tab to Target tab for that particular admin matching the 'Name' col in the List of Admins tab, and then save that excel file with the Admin Name on my desktop and then continue likewise until all the names under the List of Admins tab is done. The Col A has the list of unique names under the List of Admins tab. 
    Each of the final Excel file will be saved with only the 2 tabs Target and Instructions; the rest of the tabs must be deleted before saving. 

    I would like to do this since there is a huge volume of record lines for more than 1000s of admins throughout the year, and automating them was the only solution. 

    Please help. 
    Appreciate any suggestions for different solutions to improve time and efficiency. 

    Here is the code that I have put together so far from various searches: 

    Sub Main()
    Dim filter As String
    Dim caption As String
    Dim customerFilename As String
    Dim customerWorkbook As Workbook
    Dim targetWorkbook As Workbook
    Set targetWorkbook = Application.ActiveWorkbook
    filter = "Text files (*.xls),*.xls"
    caption = "Please Select an input file "
    customerFilename = Application.GetOpenFilename(filter, , caption)
    Set customerWorkbook = Application.Workbooks.Open(customerFilename)
    Dim Source As Worksheet
    Dim Datafile1 As Worksheet
    Set Datafile = customerWorkbook.Worksheets(1)
    Set AdminList= customerWorkbook.Worksheets(2)
    Set Source = targetWorkbook.Worksheets(1)
    Set List_of_Admins = targetWorkbook.Worksheets(3)
    Source.Range("A1", "C100000").Value = Datafile.Range("A3", "C100000").Value
    List_of_Admins.Range("A1", "D100000").Value = AdminList.Range("A3", "D100000").Value
    targetWorkbook.Worksheets(4).Activate
    customerWorkbook.Close savechanges:=False
    Dim x As Integer
    Sheets("List_of_Admins").Select
    NumRows = Range("A2", Range("A2").End(xlDown)).Rows.Count
    Sheets("List_of_Admins").Select
    Range("A2").Select
    For x = 1 To NumRows
    ActiveCell.Select
    Selection.Copy
    Sheets("Instructions").Select
    Range("C1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks :=False, Transpose:=False
    Dim filterList1 As Variant
    filterList1 = Array("Ann", "Sarah", "Kevin", "Naomi", "James")
    filterCol1 = 1
    lastrowSrc = Sheets("Source").Range("A" & Rows.Count).End(xlUp).Offset(1).Row
    lastrowDest = Sheets("Target").Range("A" & Rows.Count).End(xlUp).Row
    Sheets("Source").AutoFilterMode = False
    Sheets("Source").Range("$A$1:$O" & lastrowSrc).AutoFilter Field:=filterCol1, Criteria1:=filterList1, Operator:=xlFilterValues
    Sheets("Source").Range("A2:O" & lastrowSrc).SpecialCells (xlCellTypeVisible).Copy Destination:=Sheets("Target").Cells(lastrowDest + 1, 1)
    Dim save_as As Variant
    Dim file_name As String
    file_name = Sheets("Instructions").Range("C1")
    save_as = Application.GetSaveAsFilename(file_name, FileFilter:="Excel Files,*.xlsm,All Files,*.*")
    If save_as = False Then Exit Sub
    If LCase$(Right$(save_as, 4)) <> ".xls" Then
    file_name = save_as & ".xls"
    End If
    ActiveWorkbook.SaveAs Filename:=save_as
    'Next - repeat back to loop
    Sheets("List_of_Admins").Select
    ActiveCell.Offset(1, 0).Select
    Next
    Sheets("Instructions").Select
    Range("C1").Select
    End Sub


    Need help getting it right as mentioned above. 

    Thank you in advance.
    Friday, April 15, 2016 4:14 PM

Answers

  • Hi Shanl,

    I had make some changes in following line. I change the range address and because of that I get error. but I correct it.

    "Sheets("Source").Range("A2:O" & lastrowSrc).SpecialCells (xlCellTypeVisible).Copy Destination:=Sheets

    I also made change in following line because I don't have that much data so I change c100000 with c1000.

    Source.Range("A1", "C100000").Value = Datafile.Range("A3", "C100000").Value
    List_of_Admins.Range("A1", "D100000").Value = AdminList.Range("A3", "D100000").Value

    but after you mentioned that you have error in that line I again make it as it as you mention in your code but I did not get any error and code working fine.

    so overall now I have also the same code that you have posted above. so it does not make any sense to post it again.

    Regards

    Deepak


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Friday, April 22, 2016 2:48 AM
    Moderator

All replies

  • Hi Shanl,

    I try to run your code and every time the loop is running correctly for first time. in second time I am getting error at this line

    "Sheets("Source").Range("A2:O" & lastrowSrc).SpecialCells (xlCellTypeVisible).Copy Destination:=Sheets"

    I want to know that did the code giving the error at same line on your side?

    I will try to solve that and if I find some solution I will provide you.

    Regards

    Deepak


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Tuesday, April 19, 2016 8:30 AM
    Moderator
  • Thank you Deepak for looking into this. I am getting the Run-time error '1004' Method 'Range' of object'_Worksheet' Failed error at this line.

    Source.Range("A1", "C100000").Value = Datafile.Range("A3", "C100000").Value

    Appreciate any advice to resolve this.

    Thanks.

    Tuesday, April 19, 2016 8:58 PM
  • Hi Shanl,

    I resolve that error that I mentioned above. now code is executing without error.

    you have mentioned that you are getting an error on following line

    Source.Range("A1", "C100000").Value = Datafile.Range("A3", "C100000").Value

    but I did not get any error on that line. it is executing without error.

    only the thing is you mentioned in original post that at the end you want only 2 sheets and now with your code we are getting 4 sheets. so only need to delete the extra sheets.

    if you still getting that error then can you try to execute this code on different machine. maybe you get different result.

    Regards

    Deepak


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Wednesday, April 20, 2016 6:43 AM
    Moderator
  • Deepak, 

    Please can you post the updated code.

    Thanks.

    Thursday, April 21, 2016 10:45 PM
  • Hi Shanl,

    I had make some changes in following line. I change the range address and because of that I get error. but I correct it.

    "Sheets("Source").Range("A2:O" & lastrowSrc).SpecialCells (xlCellTypeVisible).Copy Destination:=Sheets

    I also made change in following line because I don't have that much data so I change c100000 with c1000.

    Source.Range("A1", "C100000").Value = Datafile.Range("A3", "C100000").Value
    List_of_Admins.Range("A1", "D100000").Value = AdminList.Range("A3", "D100000").Value

    but after you mentioned that you have error in that line I again make it as it as you mention in your code but I did not get any error and code working fine.

    so overall now I have also the same code that you have posted above. so it does not make any sense to post it again.

    Regards

    Deepak


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Friday, April 22, 2016 2:48 AM
    Moderator