• Status: Solved
  • Priority: Low
  • Security: Public
  • Views: 88
  • Last Modified:

Macro to cut the data and paste using a file pathway

I had this question after viewing Excel 2013 Macro to copy rows based on a criteria.

This question is in relation to my previous request - https://www.experts-exchange.com/questions/29077014/Excel-2013-Macro-to-copy-rows-based-on-a-criteria.html

Thanks Neeraj for helping me with my previous request.

The file pathways has now changed and the system failed. The details are as follows

The allocation sheet is saved in

"C:\Secured\Site Level\Site Level.xlsm"

Tasks are allocated from here.

The team level spreadsheets are now moved in to individual team folders

"C:\Secured\Team Level\Team 1\[Team 1.xlsm]
"C:\Secured\Team Level\Team 2\[Team 2.xlsm]
"C:\Secured\Team Level\Team 2\[Team 2.xlsm]

Now, when a team is selected from column M in the Site Level Allocation sheet, the macro should copy and cut the data from that row from Column C to Column I and paste it to the task allocation sheet in the individual ‘Team ’ workbook into column B to H. If there are more allocation to Team 1 from the Task allocation sheet, it would be copied to the next available row in the individual team sheet.

Some of the columns in the Team’s Allocation sheet, other than B to H, are protected, but columns B to H are not.

The selection of rows starts from row 6 only as row # 5 is the header

I made the following changes to the file pathway, but it is not working. Could anyone please help to fix the code

Thank you  Mali

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    Dim dws As Worksheet, dws2 As Worksheet
    Dim dwb2 As Workbook
    Dim dwbPath As String, Team As String, TeamNo As String
    
    If Intersect(Target, Range("A6:A" & Range("B" & Rows.Count).End(xlUp).Row)) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    On Error GoTo Skip
    Application.EnableEvents = False
    If Target <> "" Then
        Set dws = Sheets(Target.Value)
        Team = VBA.Trim(Left(Target.Value, InStr(Target.Value, " ") - 1))
        TeamNo = ExtractNumber(Target.Value)
        dwbPath = "C:\Users\Secured\Team Level\" & Team & " \Team" & TeamNo & ".xlsm"
        If Dir(dwbPath) <> "" Then
            Set dwb2 = Workbooks.Open(dwbPath, False)
        End If
        If Not dws Is Nothing Then
            Range("B" & Target.Row & ":H" & Target.Row).Copy dws.Range("B" & Rows.Count).End(3)(2)
            If Not dwb2 Is Nothing Then
                Set dws2 = dwb2.Sheets(1)
                Range("B" & Target.Row & ":H" & Target.Row).Copy
                dws2.Range("B" & Rows.Count).End(3)(2).PasteSpecial xlPasteAll
                dwb2.Close True
            End If
            Range("A" & Target.Row & ":H" & Target.Row).Delete shift:=xlUp
        End If
    End If

Open in new window

0
Matt Mali
Asked:
Matt Mali
  • 17
  • 9
  • 2
1 Solution
 
Fabrice LambertFabrice LambertCommented:
Hi,

Just change the line:
dwbPath = "C:\Users\Secured\Team Level\" & Team & " \Team" & TeamNo & ".xlsm"
To:
dwbPath = "C:\Users\Secured\Team Level\Team " & TeamNo & "\Team " & TeamNo  & ".xlsm"
0
 
Matt MaliAuthor Commented:
Thank you Fabrice. I will try and let you know
0
 
Matt MaliAuthor Commented:
Hi

The macro when executed is coming up with a Compile error message.

Sub or Function not defined

This line ,TeamNo = ExtractNumber(Target.Value), in the code is highlighted
The highlighted part of the code
Your advice please

Regards
SITE-Level.xlsm
Team-1.xlsm
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

 
Fabrice LambertFabrice LambertCommented:
Hi,

Not much to say, beside the fact that the function ExtractNumber is missing.

Ask Subodh Tiwari (Neeraj), as he's the one who provided you the code.
0
 
Matt MaliAuthor Commented:
Thanks Fabrice for your time. Much appreciated for replying me
0
 
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
In your previous project, you were also copying the target row in the individual team sheet, but there are no team sheets in the macro workbook. So do you want to copy the target row into the individual team file in the destination folder only?
0
 
Matt MaliAuthor Commented:
Thanks Neeraj

Yes, I want to cut and paste the rows into the individual team file in the destination folder only

When I initially requested, the team sheets were both in the parent workbook and also as separate team sheets. The macro was working perfectly. After a while, the management wants to have individual sheets deleted from the parent workbook.

The rows from Columns C to Column I should be pasted in to the column C to column I in the 'Task allocation' sheet in the selected individual ‘Team ’ workbook . If there are more allocation to Team 1 from the Task allocation sheet, it would be copied to the next available row in the individual team sheet.

Some of the columns in the Team’s Allocation sheet, other than C to I, are protected, but columns C to I are not. (My apologies for the errors in my questions regarding the destination rows. Its not B to H, its C to I)

If protected sheet is an issue, I will keep the sheet unprotected.

The selection of team name is now from column M. I have made those changes in the code provided by you.

Thanks again

Regards
0
 
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Okay, give this a try and pay attention to the comments added in the code and do the needful...

Code for Sheet Module:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    Dim dws2 As Worksheet
    Dim dwb2 As Workbook
    Dim dwbPath As String, Team As String, TeamNo As String
    
    If Intersect(Target, Range("M6:M" & Range("C" & Rows.Count).End(xlUp).Row)) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    On Error GoTo Skip
    Application.EnableEvents = False
    If Target <> "" Then
        TeamNo = ExtractNumber(Target.Value)
        dwbPath = "C:\Secured\Team Level\Team " & TeamNo & "\Team " & TeamNo & ".xlsm"
        If Dir(dwbPath) <> "" Then
            Set dwb2 = Workbooks.Open(dwbPath, False)
        End If
        If Not dwb2 Is Nothing Then
            Set dws2 = dwb2.Sheets(1)
            Range("C" & Target.Row & ":K" & Target.Row).Copy
            'Comment out the line below if the destination sheet in the destination file is protected and replace the "Sheet Password with the actual Password used
            'dws2.Unprotect Password:="Sheet Password"
            dws2.Range("C" & Rows.Count).End(3)(2).PasteSpecial xlPasteAll
            'Comment out the below line to protect the destination sheet again after copying the record
            'dws2.Protect Password:="Sheet Password"
            dwb2.Close True
        End If
        Range("C" & Target.Row & ":N" & Target.Row).Delete shift:=xlUp
    End If
    Range("M6").Select
Application.ScreenUpdating = True
Skip:
Application.EnableEvents = True
End Sub

Open in new window


Code on Standard Module like Module1:
Function ExtractNumber(Str As String) As String
Dim RegEx As Object
Dim Match As Object
Set RegEx = CreateObject("vbscript.regexp")
With RegEx
   .IgnoreCase = False
   .Pattern = "\d+"
   .Global = False
End With
If RegEx.test(Str) = True Then
   Set Match = RegEx.Execute(Str)
   ExtractNumber = Match(0)
Else
   ExtractNumber = ""
End If
End Function

Open in new window

1
 
Matt MaliAuthor Commented:
Thanks tons Neeraj

I will try this and give you feed back tomorrow.
0
 
Matt MaliAuthor Commented:
Hi Neeraj

I got my macros cleared after the digital scanning. I was able to try it out today.

Unfortunately the macro is not working. When the team number is selected from the column N, a pop box will come up saying, it is downloading the workbook for the team selected. This happens every time I select the team. After the team workbook is opened, I cannot see the data copied across. The data remains in the Site level workbook. I was experimenting the allocation with only team 1 and 2. I do not have workbooks prepared for other teams (I have a total of 10 teams)

However, if I select a team number, in which I do not have a workbook, the data from the site level is getting deleted.

The team level workbooks are not protected. I have changed the dropdown list from column M to N and made the necessary changes in the vba.

Any advice much appreciated.

Thanks n regards
0
 
Matt MaliAuthor Commented:
The macro is working perfectly in home computer but not in the office one. The only issue I see in the home computer is that the team level workbook should be closed at the time of allocation from Site level. It would have been better if I can transfer data while the team level workbooks are opened. Can't understand the reason why vba is working in home environment but not in office.. Any suggestions  gurus?
0
 
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Okay, please try this and see if that works...
Please note that I don't have access to Excel right now so I have tweaked the code on Notepad. :)

Please replace the code on Sheet Module with the following code.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    Dim dws2 As Worksheet
    Dim dwb2 As Workbook
    Dim dwbPath As String, Team As String, TeamNo As String
    
    If Intersect(Target, Range("M6:M" & Range("C" & Rows.Count).End(xlUp).Row)) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    On Error GoTo Skip
    Application.EnableEvents = False
    If Target <> "" Then
        TeamNo = ExtractNumber(Target.Value)
        dwbPath = "C:\Secured\Team Level\Team " & TeamNo & "\Team " & TeamNo & ".xlsm"
	On Error Resume Next
	Set dwb2 = Workbooks("Team " & TeamNo & ".xlsm")
	On Error GoTo 0
	
        If dwb2 Is Nothing And Dir(dwbPath) <> "" Then
            Set dwb2 = Workbooks.Open(dwbPath, False)
        End If
        If Not dwb2 Is Nothing Then
            Set dws2 = dwb2.Sheets(1)
            Range("C" & Target.Row & ":K" & Target.Row).Copy
            'Comment out the line below if the destination sheet in the destination file is protected and replace the "Sheet Password with the actual Password used
            'dws2.Unprotect Password:="Sheet Password"
            dws2.Range("C" & Rows.Count).End(3)(2).PasteSpecial xlPasteAll
            'Comment out the below line to protect the destination sheet again after copying the record
            'dws2.Protect Password:="Sheet Password"
            dwb2.Close True
        End If
        Range("C" & Target.Row & ":N" & Target.Row).Delete shift:=xlUp
    End If
    Range("M6").Select
Application.ScreenUpdating = True
Skip:
Application.EnableEvents = True
End Sub

Open in new window

0
 
Matt MaliAuthor Commented:
Thanks Neeraj

Just curious whether we need to specify the destination sheet and the source sheet. All workbooks have few additional sheets.

The source sheet and the destination sheet have the same name - "Task allocation"

If you have time, could you please tell me why this is not working in the office set up.

Regards
0
 
Matt MaliAuthor Commented:
It may take few days to get the macro digitally signed before I can use it. I will let you know

Will this vba work when the source and destination workbooks are open at the same time?

Thanks again
0
 
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Yes, I suppose so as I tweaked the code to check if the team file is already opened.
0
 
Matt MaliAuthor Commented:
Hi Neeraj

I deleted the old vba and pastedthe current one in Module 1. However it is not working. I will let you go now if youare busy. I will wait for your suggestions when you can

Regards
0
 
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
No, you were supposed to place the tweaked code on Sheet Module not on Moule1.
Please read Post ID: 42495105 for details and just replace the code on Sheet Module with the latest tweaked code. i.e. right click the Sheet Tab --> View Code and in the opened code window, delete the existing code and paste the latest tweaked code.
0
 
Matt MaliAuthor Commented:
Thanks Neeraj

The code is now copying the data from the range cells. But it closes the team level workbook each time Team is selected in Column M

Also new data is copying on to the same row in the destination sheet, deleting the old data and pasting top of the existing data is not copying into the next free row.
0
 
Matt MaliAuthor Commented:
Sorry..I was trying to sort this out with my limited vba knowledge. Hence in front of the computer at 1 am
0
 
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
If you don't want to close the Team file, just delete the line# 29 from the latest code on Sheet Module which is dwb2.Close True

As per line#26 dws2.Range("C" & Rows.Count).End(3)(2).PasteSpecial xlPasteAll, the data will be copied to the next available empty row in column C. If you have blank rows in source data in column C, it will overwrite the data in the destination workbook. Make sure to replace C in line#26 with the column letter from your data set which has always data in it. So if column D has always data in source data, change line#26 to dws2.Range("D" & Rows.Count).End(3)(2).PasteSpecial xlPasteAll
0
 
Matt MaliAuthor Commented:
Thanks heaps mate.

It is working.

I will try this in office setting in few days time. The reason the data is overwriting is because I was lazy to add data in column C each time I was experimenting.  I deleted line#29 and it keep the workbooks open.

Regards
0
 
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You're welcome Matt! Glad it is working as desired. :)
1
 
Matt MaliAuthor Commented:
Hi Neeraj

Just excited to tell you that the vba is working if the site level and team level workbooks are opened in the same computer. I also managed to make some changes to the vba to work from team level to the employee level.

I think I should join a vba course to learn the magic thoroughly.

The only issue is that vba works only if I open both the site level and team level at my computer.

In the actual setting, Site level workbook sits with the office manager who allocates work to different team leaders. The team leaders have their own spreadsheets opened in their computer(Surface Pro)

1.Is there a way the task allocated will be copied from the site level, from my computer to the respective team leaders workbooks in their own computers.

2. Also, If I delete the lines# 17 to 20 from the vba, does it copy the rows in to a closed workbook. The reason is, there are instances some members will not be available at the time of allocation. Instead of waiting the team member to be back, to get their workbook to be kept open at the time of allocation, I want the tasks to be allocated to the workbook which is closed.



Thanks again
0
 
Matt MaliAuthor Commented:
Me again..

Tyring to solve the issue by myself..hard try..Just wondering why the rows are not copied to a workbook opened in a different computer..Is this because we are using the path to a local directory, not UNC? (idea am getting when reading through articles)

Or use the DFS in the macro to overcome this issue?

I mean, instead of "C:\Secured\Team Level\Team " & TeamNo & "\Team " & TeamNo & ".xlsm", can we use something like  '\\localhost\c$\Secured\Team Level\Team " & TeamNo & "\Team " & TeamNo & ".xlsm'

When I look at the macro, what I understood is the rows will be copied across to an open workbook.

Everyone, from the senior manager to the employee level) has got the same access to the folder. But, if the destination workbook is opened by an team leader in his/her own computer, the rows are not copied. Instead, the destination workbook is opened as a copy in the same computer allocating the work. Then we need to save it as  copy. This happens each time a task is allocated, ending up with multiple destination workbooks.

The difficulty with me is that, each time I change macro for experimenting, I have to send it for digital scanning and get approved before using it and taking a lot of time. But helpless that the company policy.

Any suggestions?
0
 
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
The macro was initially designed considering the source and destination files are saved on the same computer.
I have no prior experience of working with macros on shared files or files on shared locations.
But you may try saving all the destination files on a mapped drive and change the path of dwbPath variable accordingly. But I guess, to edit the destination file saved on a mapped drive should not be already opened by another user otherwise you will get a SaveAs dialog box.
You may schedule a time to allocate the work when all the files are closed. You will have to try and figure it out yourself.
0
 
Matt MaliAuthor Commented:
Thanks Neeraj

I think scheduling a time to allocate work is the best option.

Thanks a ton for your patience and replies.
0
 
Matt MaliAuthor Commented:
A thousand thumbs up to the this website. You are the best
0
 
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You're welcome Matt!
Thanks for the feedback. :)
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Cloud Class® Course: SQL Server Core 2016

This course will introduce you to SQL Server Core 2016, as well as teach you about SSMS, data tools, installation, server configuration, using Management Studio, and writing and executing queries.

  • 17
  • 9
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now