[Webinar] Streamline your web hosting managementRegister Today

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 190
  • Last Modified:

Excel Page Break create tab based on cell contents

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
slatefamily
Asked:
slatefamily
  • 9
  • 9
1 Solution
 
FarWestCommented:
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
 
slatefamilyAuthor Commented:
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
 
FarWestCommented:
is the 398 rows represent the whole rows in original sheet that have?
0
[Webinar] Improve your customer journey

A positive customer journey is important in attracting and retaining business. To improve this experience, you can use Google Maps APIs to increase checkout conversions, boost user engagement, and optimize order fulfillment. Learn how in this webinar presented by Dito.

 
slatefamilyAuthor Commented:
yes
0
 
FarWestCommented:
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
 
slatefamilyAuthor Commented:
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
 
FarWestCommented:
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
 
slatefamilyAuthor Commented:
when you said whole row, I thought you meant all the columns in the row.

Sample Attached
EE-Sample.xls
0
 
FarWestCommented:
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
 
slatefamilyAuthor Commented:
Absolutely Perfect!  Thank you so much
0
 
FarWestCommented:
you are welcome, and sorry that it took from me some time to understand the requirements
0
 
slatefamilyAuthor Commented:
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
 
FarWestCommented:
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
 
slatefamilyAuthor Commented:
How would I incorporate that into the copy to another page?
0
 
FarWestCommented:
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
 
slatefamilyAuthor Commented:
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
 
FarWestCommented:
make sure not to include the percentage mark in the condition string
0
 
slatefamilyAuthor Commented:
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

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

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