View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
GS[_2_] GS[_2_] is offline
external usenet poster
 
Posts: 3,514
Default Addition to current VBA - Keep text format

Here's a revised procedure with some reusable helper routines...

Option Explicit

Type udtAppModes
Events As Boolean: Display As Boolean
CalcMode As Long: CallerID As String
End Type
Public AppMode As udtAppModes


Sub CreateTabs()
Const sSource$ = "CreateTabs" '//set procedure 'tag'

Dim vDataIn, i&, j&, sName$, ws As Worksheet

EnableFastCode sSource
For Each ws In ThisWorkbook.Worksheets
If ws.Name < "Data" Then ws.Cells.ClearContents
Next

vDataIn = Sheets("Data").Range("a2").CurrentRegion

On Error GoTo cleanup
For i = 2 To UBound(vDataIn)
sName = vDataIn(i, 1) & "_EMA_FF"
If Not bSheetExists(sName) Then _
Sheets.Add(After:=Sheets(Sheets.Count)).Name = sName

With Sheets(sName)
.Rows(1).Font.Bold = True
.Columns("D").NumberFormat = "h:mm:ss AM/PM" '//edit to suit
For j = 1 To UBound(vDataIn, 2)
.Cells(1, j) = vDataIn(1, j)
.Cells(.Cells(.Rows.Count, j).End(xlUp)(2).Row, j) _
= vDataIn(i, j)
Next 'j
.Columns.AutoFit
End With 'Sheets(sName)
Next 'i

cleanup:
EnableFastCode sSource, False
End Sub

Function bSheetExists(WksName As String) As Boolean
' Checks if a specified worksheet exists.
Dim x As Worksheet
On Error Resume Next
Set x = ActiveWorkbook.Sheets(WksName)
bSheetExists = (Err = 0)
End Function

Sub EnableFastCode(Caller$, Optional SetFast As Boolean = True)
'The following will make sure only the Caller has control,
'and allows any Caller to take control when not in use.
If AppMode.CallerID < Caller Then _
If AppMode.CallerID < "" Then Exit Sub

With Application
If SetFast Then
AppMode.Display = .ScreenUpdating: .ScreenUpdating = False
AppMode.CalcMode = .Calculation
.Calculation = xlCalculationManual
AppMode.Events = .EnableEvents: .EnableEvents = False
AppMode.CallerID = Caller
Else
.ScreenUpdating = AppMode.Display
.Calculation = AppMode.CalcMode
.EnableEvents = AppMode.Events
AppMode.CallerID = ""
End If
End With
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion