is there anyway i can prevent my macro from removing any formulas that i have on my worksheet? For example is i add the total sum to one colomn. I dont want to lose it once i use the marco.
This is the code im using..
Option Explicit
Sub SplitIntoWorksheets()
'Declare variables
Dim rRange As Range, rCell As Range
Dim wSheet As Worksheet, wSheetStart As Worksheet
Dim strTitle As String, fCol As Long
'Speed up execution
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Set activesheet to a variable name so we can refer to it easily
Set wSheetStart = ActiveSheet
'Turn off the Autofilter in case it got left on accidentally
wSheetStart.AutoFilterMode = False
'Enter the column # here to evaluate, column A = 1
fCol = 1
'Set a range out the values in the chosen column
Set rRange = Range(Cells(1, fCol), Cells(Rows.Count, fCol).End(xlUp))
'Check if "UniqueList" sheet exists
If Not Evaluate("ISREF(UniqueList!A1)") Then
Worksheets.Add().Name = "UniqueList" 'add it if needed
Else
Worksheets("UniqueList").Cells.Clear 'clear it if it exists already
End If
'Filter the Set rRange so unique item list is created
With Worksheets("UniqueList")
rRange.AdvancedFilter xlFilterCopy, , Worksheets("UniqueList").Range("A1"), True
'Set the rRange variable to the unique list of values, without the heading
Set rRange = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
End With
'Starting with the original data sheet again...
With wSheetStart
'...Evaluate the rRange items against the data sheet one unique value at a time
For Each rCell In rRange
'create a version of the value with no spaces in it so it can be used as sheetname
strTitle = Left(Replace(rCell, " ", "_"), 31)
'Filter the original data by the field:=fCol and the criteria1:=rcell
.Range("A1").AutoFilter fCol, rCell
'Test to see if a sheet already exists for this value
If Not Evaluate("ISREF('" & strTitle & "'!A1)") Then
Worksheets.Add().Name = strTitle 'add it if needed
Else
Worksheets(strTitle).Cells.Clear 'clear it if it exists
End If
'Copy filtered data (visible data only) to the new/cleared sheet
.UsedRange.Copy Destination:=Worksheets(strTitle).Range("A1")
'Clean up the new sheet's appearance
Worksheets(strTitle).Cells.Columns.AutoFit
'Loop around to the next unique value
Next rCell
'When all values are processed, turn off the Autofilter in the data
.AutoFilterMode = False
'Return to the data sheet
.Activate
End With
'reactivate application settings turned off earlier for speed
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Bookmarks