|
Grouping and moving worksheets problem?
Hi all, Is there a way of selecting all w/s using VBA that have the same last name typed in an input box? lets say the w/s is called "Bob Goes Here" and another "Bob in here" and another "Bob over Here" etc is it possible to type in an input box "Here" and have it select all sheets with the last name "Here" and move them to a new workbook Named by the name in the input box so in this case "Here.xls"? Hope you can Help, Regards,Simon -- Simon Lloyd ------------------------------------------------------------------------ Simon Lloyd's Profile: http://www.excelforum.com/member.php...fo&userid=6708 View this thread: http://www.excelforum.com/showthread...hreadid=547267 |
Grouping and moving worksheets problem?
Try the following code:
Option Explicit Sub AAA() Dim S As String Dim WS As Worksheet Dim WSArr() As String Dim Ndx As Long S = InputBox("Enter Text") If S = "" Then Exit Sub End If For Each WS In ThisWorkbook.Worksheets If Right(WS.Name, Len(S)) = S Then Ndx = Ndx + 1 ReDim Preserve WSArr(1 To Ndx) WSArr(Ndx) = WS.Name End If Next WS Worksheets(WSArr).Copy ActiveWorkbook.SaveAs S & ".xls" End Sub -- Cordially, Chip Pearson Microsoft MVP - Excel Pearson Software Consulting, LLC www.cpearson.com "Simon Lloyd" wrote in message ... Hi all, Is there a way of selecting all w/s using VBA that have the same last name typed in an input box? lets say the w/s is called "Bob Goes Here" and another "Bob in here" and another "Bob over Here" etc is it possible to type in an input box "Here" and have it select all sheets with the last name "Here" and move them to a new workbook Named by the name in the input box so in this case "Here.xls"? Hope you can Help, Regards,Simon -- Simon Lloyd ------------------------------------------------------------------------ Simon Lloyd's Profile: http://www.excelforum.com/member.php...fo&userid=6708 View this thread: http://www.excelforum.com/showthread...hreadid=547267 |
Grouping and moving worksheets problem?
Yep.
Something like this might get you started: Option Explicit Sub testme01() Dim wks As Worksheet Dim wCtr As Long Dim myStr As String Dim myNames() As String myStr = InputBox(Prompt:="enter the suffix") If Trim(myStr) = "" Then Exit Sub 'user hit cancel End If ReDim myNames(1 To Worksheets.Count) wCtr = 0 For Each wks In Worksheets If LCase(wks.Name) Like "*" & LCase(myStr) Then wCtr = wCtr + 1 myNames(wCtr) = wks.Name End If Next wks If wCtr = 0 Then MsgBox "No sheets matched!" Else 'remove any unused elements ReDim Preserve myNames(1 To wCtr) Worksheets(myNames).Copy With ActiveWorkbook .SaveAs Filename:=myStr & ".xls", FileFormat:=xlWorkbookNormal .Close savechanges:=False End With End If End Sub If you wanted that suffix to be separated with a space, you may want: If LCase(wks.Name) Like "* " & LCase(myStr) Then instead of: If LCase(wks.Name) Like "*" & LCase(myStr) Then Simon Lloyd wrote: Hi all, Is there a way of selecting all w/s using VBA that have the same last name typed in an input box? lets say the w/s is called "Bob Goes Here" and another "Bob in here" and another "Bob over Here" etc is it possible to type in an input box "Here" and have it select all sheets with the last name "Here" and move them to a new workbook Named by the name in the input box so in this case "Here.xls"? Hope you can Help, Regards,Simon -- Simon Lloyd ------------------------------------------------------------------------ Simon Lloyd's Profile: http://www.excelforum.com/member.php...fo&userid=6708 View this thread: http://www.excelforum.com/showthread...hreadid=547267 -- Dave Peterson |
Grouping and moving worksheets problem?
Thanks for the reply both!, they both worked well.....for my application Dave's code with "No Match Found" served a purpose, only one thing missing is when the sheets are moved i need the originals to be deleted! Oh and being greedy........is it possible to supress the code break if the filename already exists? Once again thank you both... Regards, Simon -- Simon Lloyd ------------------------------------------------------------------------ Simon Lloyd's Profile: http://www.excelforum.com/member.php...fo&userid=6708 View this thread: http://www.excelforum.com/showthread...hreadid=547267 |
Grouping and moving worksheets problem?
Dave's solution is preferable to mine since he uses ReDim
Preserve only once. -- Cordially, Chip Pearson Microsoft MVP - Excel Pearson Software Consulting, LLC www.cpearson.com "Dave Peterson" wrote in message ... Yep. Something like this might get you started: Option Explicit Sub testme01() Dim wks As Worksheet Dim wCtr As Long Dim myStr As String Dim myNames() As String myStr = InputBox(Prompt:="enter the suffix") If Trim(myStr) = "" Then Exit Sub 'user hit cancel End If ReDim myNames(1 To Worksheets.Count) wCtr = 0 For Each wks In Worksheets If LCase(wks.Name) Like "*" & LCase(myStr) Then wCtr = wCtr + 1 myNames(wCtr) = wks.Name End If Next wks If wCtr = 0 Then MsgBox "No sheets matched!" Else 'remove any unused elements ReDim Preserve myNames(1 To wCtr) Worksheets(myNames).Copy With ActiveWorkbook .SaveAs Filename:=myStr & ".xls", FileFormat:=xlWorkbookNormal .Close savechanges:=False End With End If End Sub If you wanted that suffix to be separated with a space, you may want: If LCase(wks.Name) Like "* " & LCase(myStr) Then instead of: If LCase(wks.Name) Like "*" & LCase(myStr) Then Simon Lloyd wrote: Hi all, Is there a way of selecting all w/s using VBA that have the same last name typed in an input box? lets say the w/s is called "Bob Goes Here" and another "Bob in here" and another "Bob over Here" etc is it possible to type in an input box "Here" and have it select all sheets with the last name "Here" and move them to a new workbook Named by the name in the input box so in this case "Here.xls"? Hope you can Help, Regards,Simon -- Simon Lloyd ------------------------------------------------------------------------ Simon Lloyd's Profile: http://www.excelforum.com/member.php...fo&userid=6708 View this thread: http://www.excelforum.com/showthread...hreadid=547267 -- Dave Peterson |
Grouping and moving worksheets problem?
Instead of using .copy, you can use .move. Remember that there has to be at
least one visible sheet in the "sending" workbook. Option Explicit Sub testme01() Dim wks As Worksheet Dim wCtr As Long Dim myStr As String Dim myNames() As String myStr = InputBox(Prompt:="enter the suffix") If Trim(myStr) = "" Then Exit Sub 'user hit cancel End If ReDim myNames(1 To Worksheets.Count) wCtr = 0 For Each wks In Worksheets If LCase(wks.Name) Like "*" & LCase(myStr) Then wCtr = wCtr + 1 myNames(wCtr) = wks.Name End If Next wks If wCtr = 0 Then MsgBox "No sheets matched!" Else 'remove any unused elements ReDim Preserve myNames(1 To wCtr) Worksheets(myNames).Move With ActiveWorkbook Application.DisplayAlerts = False .SaveAs Filename:=myStr & ".xls", FileFormat:=xlWorkbookNormal Application.DisplayAlerts = True .Close savechanges:=False End With End If End Sub Simon Lloyd wrote: Thanks for the reply both!, they both worked well.....for my application Dave's code with "No Match Found" served a purpose, only one thing missing is when the sheets are moved i need the originals to be deleted! Oh and being greedy........is it possible to supress the code break if the filename already exists? Once again thank you both... Regards, Simon -- Simon Lloyd ------------------------------------------------------------------------ Simon Lloyd's Profile: http://www.excelforum.com/member.php...fo&userid=6708 View this thread: http://www.excelforum.com/showthread...hreadid=547267 -- Dave Peterson |
Grouping and moving worksheets problem?
Thankyou both again for replying........i can do basic vba tasks but don't have the knowledge for the indepth stuff although given worked examples i can usually work things out, that said i have no idea what ReDim or Preserve do, i understand, i think that ReDim means Re-Declare-In-Memory i didnt realise you had to do this i thought once you created a Dim it was always there as it usually throws up an error if you have declared something twice! Anyway enough ramblings..................Thanks alot! Regards, Simon -- Simon Lloyd ------------------------------------------------------------------------ Simon Lloyd's Profile: http://www.excelforum.com/member.php...fo&userid=6708 View this thread: http://www.excelforum.com/showthread...hreadid=547267 |
Grouping and moving worksheets problem?
I've stolen, er, learned from lots--that, I think, came from Myrna Larson.
Chip Pearson wrote: Dave's solution is preferable to mine since he uses ReDim Preserve only once. -- Cordially, Chip Pearson Microsoft MVP - Excel Pearson Software Consulting, LLC www.cpearson.com "Dave Peterson" wrote in message ... Yep. Something like this might get you started: Option Explicit Sub testme01() Dim wks As Worksheet Dim wCtr As Long Dim myStr As String Dim myNames() As String myStr = InputBox(Prompt:="enter the suffix") If Trim(myStr) = "" Then Exit Sub 'user hit cancel End If ReDim myNames(1 To Worksheets.Count) wCtr = 0 For Each wks In Worksheets If LCase(wks.Name) Like "*" & LCase(myStr) Then wCtr = wCtr + 1 myNames(wCtr) = wks.Name End If Next wks If wCtr = 0 Then MsgBox "No sheets matched!" Else 'remove any unused elements ReDim Preserve myNames(1 To wCtr) Worksheets(myNames).Copy With ActiveWorkbook .SaveAs Filename:=myStr & ".xls", FileFormat:=xlWorkbookNormal .Close savechanges:=False End With End If End Sub If you wanted that suffix to be separated with a space, you may want: If LCase(wks.Name) Like "* " & LCase(myStr) Then instead of: If LCase(wks.Name) Like "*" & LCase(myStr) Then Simon Lloyd wrote: Hi all, Is there a way of selecting all w/s using VBA that have the same last name typed in an input box? lets say the w/s is called "Bob Goes Here" and another "Bob in here" and another "Bob over Here" etc is it possible to type in an input box "Here" and have it select all sheets with the last name "Here" and move them to a new workbook Named by the name in the input box so in this case "Here.xls"? Hope you can Help, Regards,Simon -- Simon Lloyd ------------------------------------------------------------------------ Simon Lloyd's Profile: http://www.excelforum.com/member.php...fo&userid=6708 View this thread: http://www.excelforum.com/showthread...hreadid=547267 -- Dave Peterson -- Dave Peterson |
Grouping and moving worksheets problem?
ReDim changes the size (number of elements) in an array. It can
be used only with "dynamic" arrays, those that do not have any limits set in the declaration. E.g., Dim DynArray() As Long ' can redim Dim NonDynArray(1 To 10) ' cannot redim Normally, ReDimming an array causes all existing data to be lost and the elements of the array take on their default values (0s,empty strings, or Nothings). Using the Preserve keyword causes existing data to be preserved (but is a more expensive operation). -- Cordially, Chip Pearson Microsoft MVP - Excel Pearson Software Consulting, LLC www.cpearson.com "Simon Lloyd" wrote in message ... Thankyou both again for replying........i can do basic vba tasks but don't have the knowledge for the indepth stuff although given worked examples i can usually work things out, that said i have no idea what ReDim or Preserve do, i understand, i think that ReDim means Re-Declare-In-Memory i didnt realise you had to do this i thought once you created a Dim it was always there as it usually throws up an error if you have declared something twice! Anyway enough ramblings..................Thanks alot! Regards, Simon -- Simon Lloyd ------------------------------------------------------------------------ Simon Lloyd's Profile: http://www.excelforum.com/member.php...fo&userid=6708 View this thread: http://www.excelforum.com/showthread...hreadid=547267 |
Grouping and moving worksheets problem?
Chip, Thanks for the info.....i will look at the way it was used and th why's and wherefore's Dave..............Thanks for the honesty! nice to see plagarism isn dead....haha Cheers! Simo -- Simon Lloy ----------------------------------------------------------------------- Simon Lloyd's Profile: http://www.excelforum.com/member.php...nfo&userid=670 View this thread: http://www.excelforum.com/showthread.php?threadid=54726 |
| All times are GMT +1. The time now is 11:41 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com