Split workbook based on Row Criteria. (missing column if first row contains a null)

G

G12

Board Regular
Joined
Nov 11, 2008
Messages
113
Office Version
  1. 365
Platform
  1. Windows
Hi<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:eek:ffice:eek:ffice" /><o:p></o:p>
<o:p></o:p>
I have found some code which work fairly well (credits go to Norie on a previous post). I am having a couple of little niggles with the code. <o:p></o:p>
<o:p></o:p>
For example: <o:p></o:p>
<o:p></o:p>
Lets say the criteria is in column B and the information you want to include is in columns A to I. The code identifies the unique values copies the rows with the same value (from column B) into a new work book and saves the results. <o:p></o:p>
<o:p></o:p>
This works great if there is something in all columns, but if the first row of the unique values has no information in one of the columns the whole column is omitted from the new "exported" workbook.<o:p></o:p>
<o:p></o:p>
I am not sure whether this is very clear so I will try to explain another way. <o:p></o:p>
<o:p></o:p>
Lets say that there were columns that contained no information on certain rows. Say for example Column G had no quantity in row 64 but does so on rows 65:100. In the new created workbook column G shows as an empty column. <o:p></o:p>
<o:p></o:p>
Ideally I would also want to add the headers contained on row 63, and perhaps the column widths but these are not the major issue. <o:p></o:p>
<o:p></o:p>
I had asked Norie directly but I am not sure if I was making much sense. <o:p></o:p>
<o:p></o:p>
If anyone can provide any ideas I would really appreciate it. <o:p></o:p>

Thanks in advance<o:p></o:p>
<o:p></o:p>
G12<o:p></o:p>


This is probably not going to help but if the information was as below.

We would end up with 2 new sheets 1a and 1b
1b would have all the columns
1a would have column G completly empty (Null value shown by ' ')(though it contains information on row 2) the other are fine.

A B C D E F G H I
1 z 1a z z z ' 'z z z
2 z 1a z z z z z z z
3 z 1b z z z z z z z
4 z 1b z z z z z z z



Sub DistributeRowsToNewWBS()

Dim wbNew As Workbook
Dim wsData As Worksheet
Dim wsCrit As Worksheet
Dim wsNew As Worksheet
Dim rngCrit As Range
Dim LastRow As Long

Set wsData = Worksheets("BI") ' name of worksheet with the data
Set wsCrit = Worksheets.Add

LastRow = wsData.Range("A" & Rows.Count).End(xlUp).Row

' column H has the criteria
wsData.Range("B64:B" & LastRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wsCrit.Range("A1"), Unique:=True

Set rngCrit = wsCrit.Range("A2")
While rngCrit.Value <> ""
Set wsNew = Worksheets.Add
' change x to reflect columns to copy5
wsData.Range("A64:X" & LastRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rngCrit.Offset(-1).Resize(2), CopyToRange:=wsNew.Range("A5"), Unique:=True

'' Const xlColumnWidths = 8
'' Selection.PasteSpecial Paste:=xlColumnWidths, Operation:=xlNone, _
'' SkipBlanks:=False, Transpose:=False
'' Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
'' False, Transpose:=False
'' Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
'' False, Transpose:=False

wsNew.Name = rngCrit
wsNew.Copy
Set wbNew = ActiveWorkbook
' saves new workbook in path of existing workbook
wbNew.SaveAs ThisWorkbook.Path & "\" & rngCrit

' wbNew.SaveAs "XXXXXXXXX" & "\" & rngCrit
wbNew.Close SaveChanges:=True
Application.DisplayAlerts = False
wsNew.Delete
rngCrit.EntireRow.Delete
Set rngCrit = wsCrit.Range("A2")
Wend

wsCrit.Delete
Application.DisplayAlerts = True

End Sub
 

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.
Sort by date Sort by votes
Is this what your data looks like?

Sheet BI

<TABLE style="WIDTH: 432pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=576 x:str><COLGROUP><COL style="WIDTH: 48pt" span=9 width=64><TBODY><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 48pt; HEIGHT: 12.75pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl22 height=17 width=64>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl22 width=64>1a</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl22 width=64>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl22 width=64>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl22 width=64>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl22 width=64>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl22 width=64> </TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl22 width=64>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl22 width=64>z</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 12.75pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl22 height=17>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl22>1a</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl22>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl22>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl22>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl22>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl22>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl22>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl22>z</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 12.75pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl22 height=17>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl22>1b</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl22>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl22>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl22>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl22>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl22>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl22>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl22>z</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 12.75pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl22 height=17>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl22>1b</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl22>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl22>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl22>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl22>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl22>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl22>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl22>z</TD></TR></TBODY></TABLE>

If it is I tried this code.
Code: 
Sub DistributeRows()
Dim wsAll As Worksheet
Dim wsCrit As Worksheet
Dim wsNew As Worksheet
Dim rngCrit As Range
Dim LastRow As Long
Dim LastRowCrit As Long
Dim I As Long
    
    Set wsAll = Worksheets("BI")
    
    wsAll.Rows(1).Insert
    
    wsAll.Range("A1") = "Field1"
    
    wsAll.Range("A1").AutoFill wsAll.Range("A1").Resize(, 9), Type:=xlFillDefault
    
    LastRow = wsAll.Range("A" & Rows.Count).End(xlUp).Row
    Set wsCrit = Worksheets.Add
    
    wsAll.Range("B1:B" & LastRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wsCrit.Range("A1"), Unique:=True
    
    LastRowCrit = wsCrit.Range("A" & Rows.Count).End(xlUp).Row
    
    For I = 2 To LastRowCrit
            
        Set rngCrit = wsCrit.Range("A2")
        
        Set wsNew = Worksheets.Add
        
        wsNew.Name = rngCrit
        
        wsAll.Rows("1:" & LastRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rngCrit.Offset(-1).Resize(2), _
         CopyToRange:=wsNew.Range("A1"), Unique:=False
        wsNew.Rows(1).Delete
        wsCrit.Rows(2).Delete
        
    Next I
    wsAll.Rows(1).Delete
    Application.DisplayAlerts = False
    wsCrit.Delete
    Application.DisplayAlerts = True
    
End Sub
And got these results.

Sheet 1a

<TABLE style="WIDTH: 432pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=576 x:str><COLGROUP><COL style="WIDTH: 48pt" span=9 width=64><TBODY><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 48pt; HEIGHT: 12.75pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl24 height=17 width=64>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl24 width=64>1a</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl24 width=64>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl24 width=64>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl24 width=64>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl24 width=64>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl24 width=64> </TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl24 width=64>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl24 width=64>z</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 12.75pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl24 height=17>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl24>1a</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl24>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl24>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl24>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl24>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl24>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl24>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl24>z</TD></TR></TBODY></TABLE>

Sheet 1b

<TABLE style="WIDTH: 432pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=576 x:str><COLGROUP><COL style="WIDTH: 48pt" span=9 width=64><TBODY><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 48pt; HEIGHT: 12.75pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl24 height=17 width=64>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl24 width=64>1b</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl24 width=64>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl24 width=64>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl24 width=64>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl24 width=64>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl24 width=64>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl24 width=64>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl24 width=64>z</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 12.75pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl24 height=17>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl24>1b</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl24>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl24>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl24>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl24>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl24>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl24>z</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl24>z</TD></TR></TBODY></TABLE>

Note I set up the data starting in row 1 and the code doesn't create new workbooks.

Creating the new workbooks but I'll need to look into staring the data in row 64 or whatever.

I don't know why but I've got a feeling that could cause problems.

Oh, and the code currently hard codes the no of fields, but that should be easy to fix.

I'll have a look into the row bit and post back later, but hopefully I've given you a start.:)
 
Upvote 0
Hi Norie<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:eek:ffice:eek:ffice" /><o:p></o:p>
<o:p></o:p>
Thanks for getting back, you got it exactly right. I tried that new code you attached and also your suggestion of adding something to replace all null values. <o:p></o:p>
<o:p></o:p>
The latter has worked quite well and I intend to use the original formula with the added line <o:p></o:p>
<font face=Courier New>    wsData.Range("N64:N" & LastRow).SpecialCells(xlCellTypeBlanks).Value = "0"</FONT><o:p></o:p>
<o:p></o:p>
I hope to add additional lines to copy over the headings/set column widths etc. <o:p></o:p>
<o:p></o:p>
The other thing I would like some guidance on (if I am not asking too much) is, I like the code which saved the file to the original file path. <o:p></o:p>
<o:p></o:p>
wbNew.SaveAs ThisWorkbook.Path & "\" & rngCrit<o:p></o:p>
<o:p></o:p>
However, when I run the macro the files are saved to the Excel Startup file (where the Personal.xls is located). Other than hardcoding an alternative location, is there a way around this? <o:p></o:p>
<o:p></o:p>
Thanks for your patience and assistance,<o:p></o:p>

G12
 
Upvote 0
Have you saved the workbook where you are running the code from?
 
Upvote 0
Yes, The original file is saved in a different location but the created workbooks default to the location of the Personal.xls file as this is where the code is stored in a module.

Presumably this is where the code is picking up the file location from rather than that of the original data file.

If I tagged the code to the original file I presume this would resolve itself, however this is impractical and I would like to resolve this without hardcoding the file location, DO you have any ideas?

Thanks again

G12
 
Upvote 0
As an aside, I also seem to be copying the first line (which has different criteria) onto all the workbooks. I must have the wrong offset value or something, just looking into this now.

All the best

G12
 
Upvote 0
Sorry, no.:)

I don't think I've ever used the Personal.xls.

The only thing I can think of might be to use ActiveWorkbook instead of ThisWorkbook.

You might also look into using the Parent property of the
Code: 
ActiveWorkbook.Path & "\" & rngCrit
 
wsAll.Parent.Path & "\" & rngCrit
 
Upvote 0
I replaced all null values with "0" but I also am having a problem with anything which has the text identifier (') . Now this preceeds many of the other contents in the table so find and replace would not work.

Norie, I notice this is the same issue with either of the codes you have suggested. Where there is either a null or ' as the first line of information the whole column is omitted.

I am also still struggling to understand why the first line of data comes through on all the workbooks. Correctly it comed is included on the unique criteria but it then comes through on all the other also. I thought it might have been due to an offset value, but I dont seem to be able to correct the issue.

If anyone has any suggestions.....
 
Upvote 0
Thought I would post my final code for the workbook splitter. As I mentioned above most of this has come from Norie, I have just tweaked a couple of bits to suit my own needs but thought someone else may find it useful as it addresses some of the issues I came across.

You may have to adjust the parts of the code that take care of null etc values but it is there if you need it.

Cheers

G12


Sub SplitworkbookOnly()

Dim wbNew As Workbook
Dim wsData As Worksheet
Dim wsCrit As Worksheet
Dim wsNew As Worksheet
Dim rngCrit As Range
Dim FltrCrit As Variant
Dim FirstRow1 As Long
Dim LastRow1 As Long
Dim Name As String

'----------------------------------------------------------------
' Split Workbooks based on Contained Criteria
' Table of Data MUST:-
' - Have a blank column to the right of the data
' - Have nothing below the data
' - Have individual headings for every column
' - Not contain blank cells
' - Not contain cells containing only the (') Text identifier
'----------------------------------------------------------------
Name = "Workbook Splitter"

Application.ScreenUpdating = False

Set wsData = Worksheets("BI") ' name of worksheet with the data

' Determin First and Final Rows
LastRow1 = wsData.Range("A" & Rows.Count).Offset(0).End(xlUp).Row
FirstRow1 = wsData.Range("A" & LastRow1).End(xlUp).Offset(1).Row

''' Add zero values to null or to ' text identifier cells
''' On Error Resume Next
''' Deal with blank cells in the specified range
'' wsData.Range("N" & FirstRow1 & ":X" & LastRow1).SpecialCells(xlCellTypeBlanks).Value = "0"
''' Remove text identifying marks in the specified range
'' wsData.Range("E" & FirstRow1 & ":E" & LastRow1).TextToColumns Destination:=Range("E" & FirstRow1), DataType:=xlDelimited, _
'' TextQualifier:=xlSingleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
'' Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
'' :=Array(1, 1)
''' Swaps the cells formally containing the text identifying marks to zeros.
'' wsData.Range("E" & FirstRow1 & ":E" & LastRow1).SpecialCells(xlCellTypeBlanks).Value = "0"

' Add Criteria Sheet
Set wsCrit = Worksheets.Add

' Column B has the criteria Set Criteria Variables
wsData.Range("B" & FirstRow1 & ":B" & LastRow1).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wsCrit.Range("A1"), Unique:=True

Set FltrCrit = wsCrit.Range("A1:A2")
Set rngCrit = wsCrit.Range("A2")
While rngCrit.Value <> ""

Set wsNew = Worksheets.Add

' Change x to reflect columns to copy to......"A5" is destination Range
wsData.Range("A" & FirstRow1 & ":X" & LastRow1).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=FltrCrit, CopyToRange:=wsNew.Range("A5"), Unique:=True


' Rename new sheet to Criteria
wsNew.Name = rngCrit

' Move to new workbook
wsNew.Copy
Set wbNew = ActiveWorkbook

' Saves new workbook in path of existing workbook
wbNew.SaveAs wsData.Parent.Path & "\" & rngCrit

Application.DisplayAlerts = False
wbNew.Close SaveChanges:=True

' Delete and reset code
wsNew.Delete
rngCrit.EntireRow.Delete
Set FltrCrit = wsCrit.Range("A1:A2")
Set rngCrit = wsCrit.Range("A2")
Wend

wsCrit.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "The " & Name & " Macro is Complete!", vbInformation
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

KlausW
  • Solved
copy data from several closed workbooks to one workbook.
Replies
5
Views
699
KlausW
KlausW
T
  • Question
Add rows above cells containing specific string.
Replies
0
Views
168
topi1
T
R
  • Question
Extract rows based upon unique data in first column of an array
Replies
2
Views
209
RJC40
R
S
  • Question
Creating a dynamic Subject line from information in a particular Excel column
Replies
0
Views
395
StevieMP
S
J
  • Question
How to speed up the for - next statement using always the last 200 rows that contains text of a column
2
Replies
11
Views
892
Micron
M

Forum statistics

Threads
1,215,045
Messages
6,122,840
Members
449,096
Latest member
Erald

Share this page

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