Solved

Excel Page Break create tab based on cell contents

Posted on 2015-02-09
18
125 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
  • 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
 

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 500 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
6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

 

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

Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

Join & Write a Comment

Suggested Solutions

This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
Describes a method of obtaining an object variable to an already running instance of Microsoft Access so that it can be controlled via automation.
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

743 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

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now