Macro to copy cells from worksheet with variable name.

t0ny84

Board Regular
Joined
Jul 6, 2020
Messages
205
Office Version
  1. 365
  2. 2016
  3. 2013
Platform
  1. Windows
  2. Mobile
  3. Web
Hi All,

I was wondering if this is a) possible b) someone had some example code.

I have 2 workbooks (Workbook A and Workbook B)

Workbook A - This is the main workbook which holds all required data.
Workbook B - This is a workbook which is downloaded from Microsoft Forms and has a variable name which is made up of Work Survey and a number which is based on responses entered. e.g. Work Survey (1-8).xls

What I am trying to do is when I open Workbook A and download and open Workbook B I can run a macro in Workbook A which would do either:

1) Would locate the open workbook with Work Survey in the name and then copy the worksheet from this workbook over to Workbook A. Then have another macro which I could use to automate sorting oldest to newest, deleting duplicates keeping only the newest rows based on date\time entry.

2) Workbook B - Sort oldest to newest based on date\time in column X
- Delete duplicate rows based keeping the newest based on the date in column X.
- Input Box to allow user to enter new name for spreadsheet.
- Copy the now edited sheet to the end of Workbook A

Thanks in advance,
t0ny84
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
In order to overcome the issue of the filename being dynamic, I'd suggest using one of the built-in file pickers.
These tell Windows to open one of its "Normal" file/folder selectors, which allows the user to select the file. Once the user's made their choice, the filename & path is stored, ready to be used by the rest of the code.

Here's a sample of just one of them:
VBA Code:
Sub Get_a_file()
Dim fpath As String

    With Application.FileDialog(msoFileDialogFilePicker)               

        If .Show <> 0 Then
            fpathath = .SelectedItems(1)
        
'This is where the rest of your code will go - to open the file, copy stuff etc.
' You can do a search on Mr. Excel for this type of code - there's tons of it available.
            
        End If
    End With
End Sub
 
Upvote 0
sykes - Thank you for the push in the right direction, after I read your comment I had a light bulb moment and have managed to piece together the below code, this currently:
- Requests user to select file where data is to be taken.
- Prompt for the required name for the new sheet.
- Allow user to enter any special symbol which will be converted to .
- Delete columns not matching list in code.

To Do\Require Help:
- Code For Deleting Columns
Currently each column needs to have the specific text as shown in below code e.g. Sunday. As the columns include a date needing to work out how to change it so these words act as keywords to search the columns with and if found keep column. Search and keep all columns which include Sunday in the column title.

- Sort A to Z - Oldest To Newest
So far all code I have found seems to break other parts of my script. It would just need to do Sort Oldest To Newest based on date in "Column A".

- Search new worksheet for duplicated names shown in "Column D"

- Delete all rows which the duplicated names are found except for the most recent one (based on date in "Column A")

Once the above is completed it would leave a list showing:
Date - Name - Sunday DATE - Monday Date - etc.

VBA Code:
Sub GetFileCopyData()
  Dim Fname As String
  Dim SrcWbk As Workbook
  Dim DestWbk As Workbook
  Dim NewSheetName As Variant
  Dim currentColumn As Integer
  Dim columnHeading As String
  Dim ilChar

  Application.ScreenUpdating = False
    
  Set DestWbk = ThisWorkbook

  MsgBox ("Step 1 - Select Casual Roster Spreadsheet")
 
  Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", Title:="Select a File")
  If Fname = "False" Then
  MsgBox ("Action Cancelled")
  Exit Sub
  End If
  
  Set SrcWbk = Workbooks.Open(Fname)
  
  ilChar = Array("\", "/", "*", "[", "]", ":", "?")
  Enter_NewSheetName:   
  NewSheetName = "Preferences - " & Application.InputBox("Enter Scheduling Period:" & vbCrLf & _
  "e.g. 09/08 - 22/08", "New Scheduling Period")
 
  SrcWbk.ActiveSheet.Copy After:=DestWbk.Sheets(Sheets.Count)
  DestWbk.ActiveSheet.Name = NewSheetName
  SrcWbk.Close False
 
  Enter_DeleteColumns:
  For currentColumn = Sheets(NewSheetName).UsedRange.Columns.Count To 1 Step -1
  columnHeading = Sheets(NewSheetName).UsedRange.Cells(1, currentColumn).Value

'Check whether to preserve the column
 Select Case columnHeading
   ' Below are columns which need to keep. Any not listed here will be deleted.
    Case "Select Your Name", "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday%", "Sunday*",   "Comments regarding your availability or preferences for Week 1", "Comments regarding your availability or preferences   for Week 2"
  Case Else
         Sheets(NewSheetName).Columns(currentColumn).Delete
      End Select
 Next
    
' To Add In
' Sort A to Z Oldest To Newest
' Search For Duplicates in Name Column
' Delete all rows which would be a duplicate but keep the newest

MsgBox ("Completed")
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Hi Tony
That's good news - that it's enabled you to make a start.
I'm having broadband problems at the moment, and the engineers are coming at 08:00 (local UK time - BST) to investigate. It'll not be long before they get started - cutting me off in the process, so-to-speak!
Just to let you know, I'm looking at your post & remaining issues/requirements, but may not be able to respond very quickly.
It could be that some of the other (much better than I) Folk, step-in anyway.

One thing that's already struck me, is your use of message boxes. I've gone away from these as much as possible, the reason being that users very quickly get fed up with having to respond to the annoying Windows messages, and associated sounds.
What I tend to do now, is use UserForms - if necessary keeping them on display, and using one of these as your "User interface." Just one label is all that's needed for displaying all the messages to the user, and you can easily stick textboxes on there (great for user input, instead of the annoying Windows InputBox), and buttons for yes/no/cancel etc.
In your case, you could display:
  1. "Action Cancelled"
  2. "Step 1 - Select Casual Roster Spreadsheet"
  3. "Completed"
...all by using:
VBA Code:
Userform1.Label1.Caption
... and if you make the label the same colour as the userform, it looks good, because all you see is the text.

Any user input can be placed in a TextBox (once again, you probably only need one of these):
"Preferences - " & Application.InputBox("Enter Scheduling Period:" etc

When you first display the userform, all of the controls can be set to how you want them, by using the userform's "Initialize" event.
Then, if you display it by using:
VBA Code:
UserForm1.show modeless
... the form will remain visible throughout the life of the workbook - whether the code's running, or not. When you want to get rid, you can either just make it invisible (then visible again, whenever you want, and it'll be in the same state as before) or use:
VBA Code:
Unload UserForm1
... to completely unload it from memory - ready for it's next use.

I find this makes for a project that's more flexible for you to code, and more intuitive for your users to interact with.
They can also move the Userform around the page, by grabbing the taskbar - as always - so if it gets in the way, they can just move it.

Please accept my apologies if I'm teaching granny to suck eggs...

Hopefully, back in a bit, with more help...

Good luck.
 
Upvote 0
Hey sykes, definitely not teaching granny to suck eggs. I'm more of an old dog learning new tricks (Excel).

The message boxes are more just while I am writing the code so I know what is happening with in the script.

I like the idea of building a form now to spend some time playing.
 
Upvote 0
Good to hear it's helping.
A really, really handy alternative to a msgbox, to see how you code's performing, is by using the line:
VBA Code:
 debug.print [then insert the variable, or whatever you want to observe]
This displays what you want to see, or test, in the "Immediate" window (so you have to have that one open in your VBA browser, too, but as with any other windows, you can re-size it, and have it set up quite small, so it doesn't take up much room).
So, for example, if you wanted to see what's happening to your variable "myvar" during execution, you might use:
VBA Code:
debug.print myvar
or perhaps
VBA Code:
debug.print sheets("Sheet2").Range("B3").value / myvar

...also, you can test bits of gash code in the immediate window.
Put something into A17 on the active worksheet, then copy & paste this line into the immediate window:
VBA Code:
debug.Print activesheet.range("a17").value
Once pasted, press the return key to run the code...
Saves tons of time, instead of having to write little subs called "test" & "test1" etc
You might also try the line:
VBA Code:
debug.Print (36+4)/3
...then return, again.

and, finally - incorporated into a bit of code...
VBA Code:
Sub tst()
Dim int1 As Integer
Dim int2 As Integer

int1 = 26
int2 = 2

Debug.Print "int1= " & int1 & ", int2= " & int2 & ",  int1 X int2 = " & int1 * int2
End Sub
...then use F5 to run the code (or F8 to step through your code, line-by-line, which is also extremely useful sometimes).
 
Upvote 0
Would you like to try this:
NB - UNTESTED, so try out on a COPY of your workbook, first!
The only thing I've not bothered with yet, is deleting rows with duplicate names. I wanted to see if this works, first.

VBA Code:
Sub GetFileCopyData()
  Dim Fname As String
  Dim SrcWbk As Workbook
  Dim DestWbk As Workbook
  Dim NewSheetName As Variant
  Dim currentColumn As Integer
  Dim columnHeading As String
  Dim ilChar

  Application.ScreenUpdating = False
    
  Set DestWbk = ThisWorkbook

  MsgBox ("Step 1 - Select Casual Roster Spreadsheet")
 
  Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", Title:="Select a File")
  If Fname = "False" Then
  MsgBox ("Action Cancelled")
  Exit Sub
  End If
  
  Set SrcWbk = Workbooks.Open(Fname)
  
  ilChar = Array("\", "/", "*", "[", "]", ":", "?")
Enter_NewSheetName:
  NewSheetName = "Preferences - " & Application.InputBox("Enter Scheduling Period:" & vbCrLf & _
  "e.g. 09/08 - 22/08", "New Scheduling Period")
 
  SrcWbk.ActiveSheet.Copy After:=DestWbk.Sheets(Sheets.Count)
  DestWbk.ActiveSheet.Name = NewSheetName
  SrcWbk.Close False
 
Enter_DeleteColumns:

With Sheets(NewSheetName)

      For currentColumn = .UsedRange.Columns.Count To 1 Step -1
      columnHeading = .UsedRange.Cells(1, currentColumn).Value
    
    'Check whether to preserve the column
     Select Case columnHeading
       ' Below are columns which need to keep. Any not listed here will be deleted.
        Case "Select Your Name", "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday%", "Sunday*", "Comments regarding your availability or preferences for Week 1", "Comments regarding your availability or preferences   for Week 2"
            GoTo nextcol
      Case Else
             .Columns(currentColumn).Delete
          End Select
nextcol:     Next
    
    .UsedRange.Sort Range("A1"), xlAscending, , , , , , xlYes
    
    ' To Add In
    ' Sort A to Z Oldest To Newest
    ' Search For Duplicates in Name Column
    ' Delete all rows which would be a duplicate but keep the newest
    
    MsgBox ("Completed")
        Application.ScreenUpdating = True
    
End With
End Sub
 
Upvote 0

Hey sykes thanks for your help, slowly (oh very slowly) I have been chipping away at it and have nearly got it to work!
The issue I am having is with deleting rows which have a duplicate on them. I originally had the below code but when I check it now I get an error 1004 - Application defined or object defined error.
The only difference is I closed Excel and then came back to try something else! :(

VBA Code:
Enter_DeleteDuplicates:
'Sorts Start Time Column Newest To Oldest (Descending)
' Deletes all duplicates based on the Select Your Name coloumn
With NewSheetName
.Range("A1", Range("A1").End(xlDown)).Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlYes
.[A1].CurrentRegion.RemoveDuplicates Columns:=3, Header:=xlYes
End With
 
Upvote 0
Seems VBA doesn't like a combination of NewSheetName / Sheets(NewSheetName) / Worksheets(NewSheetName) being used. Changed all NewSheetName references not used in naming the preferences sheet to Sheets(NewSheetName) and no more issues!
 
Upvote 0
That's good news! Does that mean it's all working, now?
 
Upvote 0

Forum statistics

Threads
1,213,494
Messages
6,113,986
Members
448,538
Latest member
alex78

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top