Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
Solved

Excel Page Break create tab based on cell contents

Posted on 2015-02-09
18
Medium Priority
?
178 Views
Last Modified: 2016-02-11
I need help with a macro where I find in excel where a certain cell value is contained and then copying a specific number of rows each time to paste into a new tab.

This is the cell value in A1
Profile: Physician Profile-Surgery

I want to find it every time it appears and move it and the data (398 rows) to a new tab.
and rename the tab with A2
Provider: 307116
0
Comment
Question by:slatefamily
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 9
  • 9
18 Comments
 
LVL 12

Expert Comment

by:FarWest
ID: 40598483
the question is not clear for me, could you elaborate and provide a sample file
is A1 a sheet or Cell address, is A2 a sheet?, do you mean excel worksheet when you say tab?
0
 

Author Comment

by:slatefamily
ID: 40598496
Worksheet, and the first time the cell value is in A1, but each time that cell value comes up I want to take it and it will always be 398 rows of data and move it to a new worksheet
0
 
LVL 12

Expert Comment

by:FarWest
ID: 40598514
is the 398 rows represent the whole rows in original sheet that have?
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 

Author Comment

by:slatefamily
ID: 40598531
yes
0
 
LVL 12

Expert Comment

by:FarWest
ID: 40598635
try this code
Public Sub copyrows()
If ActiveSheet.Cells(1, 1).Value = "Your search value" Then
  ActiveSheet.Copy , ActiveSheet
  Sheets(Sheets.Count).Name = "A2"
End If
End Sub

Open in new window

0
 

Author Comment

by:slatefamily
ID: 40598685
It doesn't copy and move the 400 rows, it copies the whole worksheet.  I'm trying to create new worksheets where a new report should start, and it renames it the same as the active sheet.
0
 
LVL 12

Expert Comment

by:FarWest
ID: 40598860
sorry when I asked if the 398 rows represents the whole rows you said yes,
so it is better to copy the whole sheet to easily keep formation and column width
your requirements still not clear to me
loading a sample sheet may help
0
 

Author Comment

by:slatefamily
ID: 40598935
when you said whole row, I thought you meant all the columns in the row.

Sample Attached
EE-Sample.xls
0
 
LVL 12

Accepted Solution

by:
FarWest earned 2000 total points
ID: 40600852
ok, you mentioned something regarding page break so here is two vba sub, the first will make the page break based on your condition, the other will copy and name each profile in separate sheet or tab as you like to name it
Option Explicit

Sub PageBreakOnString()
Dim ConditionString As String
Dim LastRow As Integer, ii
ConditionString = "Profile: Physician Profile-Surgery"
LastRow = ActiveSheet.UsedRange.Rows.Count
 For ii = 2 To LastRow
  If Cells(ii, 1) = ConditionString Then
   ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Cells(ii, 1)
  End If
 Next
End Sub

Sub CopyOnString()
Dim ConditionString As String, MasterSheetName, NewSheetName
Dim LastRow As Integer, ii, FindCount, StartRange, EndRange
MasterSheetName = "Profile Export"
Worksheets(MasterSheetName).Activate
FindCount = 0
StartRange = 0
EndRange = 0
NewSheetName = MasterSheetName
ConditionString = "Profile: Physician Profile-Surgery"
LastRow = Worksheets(MasterSheetName).UsedRange.Rows.Count
 For ii = 1 To LastRow
  If Worksheets(MasterSheetName).Cells(ii, 1) = ConditionString Or ii = LastRow Then
    If FindCount > 0 Then ' not first find
    EndRange = ii - 1
    Worksheets.Add , Worksheets(NewSheetName)
    
    DoEvents
    NewSheetName = Split(Worksheets(MasterSheetName).Cells(StartRange + 1, 1).Value, ":", 2)(1)
    ActiveSheet.Name = NewSheetName
    DoEvents
    Worksheets(MasterSheetName).Range(LTrim(CStr(StartRange)) & ":" & LTrim(CStr(EndRange))).Copy _
    Destination:=Worksheets(NewSheetName).Range("1:1")
    Worksheets(NewSheetName).Columns("A:I").AutoFit
    End If
    FindCount = FindCount + 1
    StartRange = ii
    EndRange = 0
    
  End If
 Next
End Sub

Open in new window

0
 

Author Closing Comment

by:slatefamily
ID: 40601209
Absolutely Perfect!  Thank you so much
0
 
LVL 12

Expert Comment

by:FarWest
ID: 40601238
you are welcome, and sorry that it took from me some time to understand the requirements
0
 

Author Comment

by:slatefamily
ID: 40601297
One last question, or I can open another one.  If I have several of these, can I use a like condition for the ConditionString "Profile: Physician Profile%"  Something like that?
0
 
LVL 12

Expert Comment

by:FarWest
ID: 40601317
you mean like using "LIKE" in SQL

if so you can use InStr function
so the condition will be
If instr(Cells(ii, 1) , ConditionString) >  0
0
 

Author Comment

by:slatefamily
ID: 40601424
How would I incorporate that into the copy to another page?
0
 
LVL 12

Expert Comment

by:FarWest
ID: 40601445
replace the bold string
 
For ii = 1 To LastRow
  If Worksheets(MasterSheetName).Cells(ii, 1) = ConditionString Or ii = LastRow Then
    If FindCount > 0 Then ' not first find

with this
instr(Cells(ii, 1) , ConditionString) >  0
0
 

Author Comment

by:slatefamily
ID: 40601459
I tried that it doesn't work for the copy to another page.  No error, but it doesn't move

LastRow = Worksheets(MasterSheetName).UsedRange.Rows.Count
 For ii = 1 To LastRow
 If InStr(Cells(ii, 1), ConditionString) > 0 Or ii = LastRow Then
    If FindCount > 0 Then ' not first find
    EndRange = ii - 1
    Worksheets.Add , Worksheets(NewSheetName)
0
 
LVL 12

Expert Comment

by:FarWest
ID: 40601492
make sure not to include the percentage mark in the condition string
0
 

Author Comment

by:slatefamily
ID: 40601499
I created a new question for this, to add more points since I am asking for more.  What do you mean by percentage mark?

There is not a percentage mark here

LastRow = Worksheets(MasterSheetName).UsedRange.Rows.Count
 For ii = 1 To LastRow
 If InStr(Cells(ii, 1), ConditionString) > 0 Or ii = LastRow Then
    If FindCount > 0 Then ' not first find
    EndRange = ii - 1
    Worksheets.Add , Worksheets(NewSheetName)
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes a serious pitfall that can happen when deleting shapes using VBA.
We live in a world of interfaces like the one in the title picture. VBA also allows to use interfaces which offers a lot of possibilities. This article describes how to use interfaces in VBA and how to work around their bugs.
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

618 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question