Add a new worksheet containing data if cell =/= cell-1

[Jerry138889]

Hey.

I'm trying to make a new worksheet with data for every change in Customer name. So, for example, the below table would represent the raw data on sheet 1. I want the macro to create a new worksheet whenever the Customer Name changes i.e. (Customer Name) =/= (Customer Name -1).

I want sheet 2 to have XYZ's data only, sheet 3 to have TUNIJM's data only, sheet 4 to have SGFG etc.

Customer Name		Currency	Account Type	Balance
XYZ Ltd		£	Normal	1000
XYZ Ltd		$	Normal	1000
XYZ Ltd		€	Priority	1000
XYZ Ltd		Y	Normal	1000
TUNIJM Ltd		£	Normal	1000
TUNIJM Ltd		€	Priority	1000
SGFG Ltd		£	Normal	1000
SGFG Ltd		$	Normal	1000
SGFG Ltd		$	Priority	1000
SGFG Ltd		£	Priority	1000
SGFG Ltd		€	Normal	1000
UKBN Ltd		€	Normal	1000
UKBN Ltd		$	Normal	1000
UKBN Ltd		€	Normal	1000

<tbody>
</tbody>

I've been looking around the forum for a bit and have come up (possibly) with parts of the code I'm looking for. The macro could name the new worksheet after the Customer Name too, but that is not a priority.

I've tried to fiddle about with this and replace some text in the macro but I'm probably not substituting properly and I don't really understand what I'm doing!

If Range("A" & Rw) <> Range("A" & Rw - 1) Then
            For cnt = 1 To sh
                Sheets(sh).Insert

I appreciate any help.

 

[rallcorn]

Welcome to the forum.

The below code should work, but you'll need to adjust for your actual "raw data" sheet name (code uses "Sheet1")

Place code in standard module.

Sub Jerry138889()
 
Dim wbThis As Workbook: Set wbThis = ThisWorkbook
 
Dim SourceSht As Worksheet: Set SourceSht = Sheets("Sheet1")
Dim TmpSht As Worksheet
 
Dim CopyRng As Range
Dim LR As Long, c As Long, sh As Long
Dim BeginRow As Long, EndRow As Long
 
Dim CurrentCust As String
 
Application.DisplayAlerts = False
Application.ScreenUpdating = False
 
'Ensure Macro workbook is the active workbook
wbThis.Activate
 
'Add a new (temporary) worksheet into which Customer Names
'will be deposited for the purpose of removing
'duplicates to arrive at a list of UNIQUE customer names
'for which individual worksheets will be created.
Sheets.Add Before:=SourceSht
 
'Name the new sheet
ActiveSheet.Name = "Temp"

'Assign variable for new sheet
Set TmpSht = Sheets("Temp")
 
'Copy the Customer Names to the new sheet
SourceSht.Range("A2:A" & SourceSht.Range("A" & Rows.Count).End(xlUp).Row).Copy TmpSht.Range("A1")
Application.CutCopyMode = False
 
'Remove duplicate Customer Names
TmpSht.Range("A1:A" & TmpSht.Range("A" & Rows.Count).End(xlUp).Row).RemoveDuplicates Columns:=1, Header:=xlNo
 
'Insert row at top
TmpSht.Range("A1").EntireRow.Insert
 
'Add headings
TmpSht.Range("A1").Value = "Unique Customer Names"
TmpSht.Range("B1").Value = "Formula Begin Customer Range Row"
TmpSht.Range("C1").Value = "Formula End Customer Range Row"
 
'Formula to find the FIRST ROW of each Customer's data
TmpSht.Range("B2:B" & TmpSht.Range("A" & Rows.Count).End(xlUp).Row).Formula = "=MATCH(A2,'Sheet1'!A:A,0)"
'Turn formula to values
TmpSht.Range("B2:B" & TmpSht.Range("A" & Rows.Count).End(xlUp).Row).Value = TmpSht.Range("B2:B" & TmpSht.Range("A" & Rows.Count).End(xlUp).Row).Value
 
'Formula to find the LAST ROW of each Customer's data
TmpSht.Range("C2:C" & TmpSht.Range("A" & Rows.Count).End(xlUp).Row).Formula = "=SUMPRODUCT(MAX(('Sheet1'!A:A=A2)*ROW('Sheet1'!A:A)))"
'Turn formula to values
TmpSht.Range("C2:C" & TmpSht.Range("A" & Rows.Count).End(xlUp).Row).Value = TmpSht.Range("C2:C" & TmpSht.Range("A" & Rows.Count).End(xlUp).Row).Value
 
'Make all the columns wide enough to display all data
Cells.EntireColumn.AutoFit

'Variable to find the # of the last row on temporary sheet
'(needed for looping customers)
LR = TmpSht.Range("A" & Rows.Count).End(xlUp).Row
 
'Ensure Temp sheet is the active sheet
TmpSht.Activate
 
'Begin looping customers
For c = 2 To LR
    'Find current number of sheets in workbook
    sh = Sheets.Count
    
    'Variable that holds the current customer's name
    '(will be used to name new worksheet)
    CurrentCust = TmpSht.Range("A" & c).Value
    
    'Row # of 1st row of current customer's data
    BeginRow = TmpSht.Range("B" & c).Value
    
    'Row # of last row of current customer's data
    EndRow = TmpSht.Range("C" & c).Value
    
    'Use current customer's 1st row # & last row # to define the
    'current customer's range of data to be copied to new sheet
    Set CopyRng = SourceSht.Range("A" & BeginRow & ":E" & EndRow)
    
    'Add worksheet
    Sheets.Add After:=Sheets(sh)
    
    'Name the new worksheet the current customer's name
    'CAUTION - if the current customer's name includes
    'a "/" or other symbols not allowed in a worksheet name, an
    'error will occur
    ActiveSheet.Name = CurrentCust
    
    'Copy current customer's data & paste it into new sheet
    CopyRng.Copy Sheets(CurrentCust).Range("A1")
    Application.CutCopyMode = False
    
    'Add headings on new sheet
    Range("A1").EntireRow.Insert
    Range("A1").Value = "Customer Name"
    Range("C1").Value = "Currency"
    Range("D1").Value = "Account Type"
    Range("E1").Value = "Balance"
    
    'Make all the columns wide enough to display all data
    Cells.EntireColumn.AutoFit
    
Next c
 
'Get rid of the temporary worksheet that holds
'the list of unique customers and the begin/end row #s
TmpSht.Delete
 
MsgBox "Done!"
 
Application.DisplayAlerts = True
Application.ScreenUpdating = True
 
End Sub

 

[rallcorn]

One other thing, note that the code has formulas that reference 'Sheet1'! You'll need to modify those formulas to be your actual "Raw Data" sheet name.

 

[Jerry138889]

Hey rallcorn.

Wow, I really appreciate the work that went into that. Sure looks a lot more complicated than what I came up with haha.

When I run the macro, it creates a new sheet called "Temp". The Temp sheet contains just the customer name column. Sheet 1 contains all the data it contained originally (including Customer Name) but then the error pops up and the macro stops. This is the error:


'Run-time error "1004"
Application-defined or object-defined error'

Any ideas? Thanks again.

 

[rallcorn]

Sent you a private message.