Hi
I was hoping someone could help me on how to move within lines of code. What I mean is I have a script that is running pretty well, however I need part of my script to repeat again just not from the very beginning? Here is an example however I'm still working on this project so bare with my garbage.
I would like to return to this line of code below from the bottom of my script?
Another thing I was thinking is I will need to add a worksheet named info but only if a sheet info doesn't exist not sure how to write that bit of code either.
Still Learning and Appreciate all your help...
Thank You,
Mike
Sub Macro100()
Dim ws As Worksheet, strSource As String
Dim pt As PivotTable, pc As PivotCache, pf As PivotField
For Each ws In ActiveWorkbook.Worksheets
strSource = ws.Name & "!R4C1:R5000C6"
ActiveWorkbook.Worksheets.Add 'new worksheet becomes the active sheet
'ActiveSheet.Name = "Info"
Set pc = ActiveWorkbook.PivotCaches.Add(xlDatabase, strSource)
Set pt = pc.CreatePivotTable(Range("A1")) 'pivot table at A1 on new sheet
Set pf = pt.PivotFields("Order Number")
pt.AddDataField pf, "Count of Order Number", xlCount
pt.AddFields RowFields:="Name"
Next ws
Dim stname As String Dim sht
Dim OutR As Long
Dim Data As String
Data = "Data"
stname = "Info"
Worksheets.Add().Name = Data
Sheets(2).Select
Sheets(2).Name = stname
'stname.Name
'If Not CBool(Len(Sheets(stname).Name)) Then
' Worksheet.Add().Name = stname
For Each cell In Worksheets("Info").Range("B3", Range("B3").End(xlDown))
cell.ShowDetail = True
Rows("1:3").Select
Selection.Insert Shift:=xlDown
Range("A1").FormulaR1C1 = "=R[4]C"
Range("C1").FormulaR1C1 = "=COUNT(R[4]C:R[499]C)"
Range("D1:F1").FormulaR1C1 = "=SUM(R[4]C:R[499]C)"
Range("A1:F1").Select
Selection.Copy
Sheets("Data").Select
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Font.Bold = False
Rows("3:3").Select
Selection.Insert Shift:=xlDown
Sheets(2).Select
Application.DisplayAlerts = False
Sheets(2).Delete
Application.DisplayAlerts = True
Next cell
Sheets("info").Select
Application.DisplayAlerts = False
Sheets("info").Delete
Application.DisplayAlerts = True
'Sheets("Jan2").Select
'Sheets("Jan2:Jan28").Delete
'Sheets("Data").Select
Worksheets("Data").Move After:=Worksheets(Worksheets.Count)
Sheets("Data").Select
Dim jan As String
jan = "Jan 2008"
Sheets("Data").Name = jan
Sheets(1).Select
Dim Wsht As Worksheet
For Each Wsht In Worksheets
Select Case True
Case Wsht.Name Like "Sheet*"
'Case Wsht.Name Like "Info*"
' Application.DisplayAlerts = False
' Wsht.Delete
' Application.DisplayAlerts = True
End Select
Next Wsht
'Dim Wsht As Worksheet
'Sheets(2).Select
'Sheets(2).Delete
'For Each Wsht In Worksheets
'Select Case True
'Case Wsht.Name Like "Sheet*"
' Case Wsht.Name Like "Info*"
' Application.DisplayAlerts = False
' Wsht.Delete
' Application.DisplayAlerts = True
'End Select
'Next Wsht
'Next cell
'Sheets(stName).ClearContents
'OutR = 3
'For Each sht In Sheets
' If sht.Name <> stName Then
' sht.Range("A1:E1").Copy
' Sheets(stName).Cells(OutR, 1).PasteSpecial Paste:=xlPasteAll
' OutR = OutR + 1
' End If
'Next
'Application.DisplayAlerts = False
'For Each sht In Sheets 'Remove all sheets except "Data"
' If sht.Name <> stname Then
' Sheets(sht.Name).Delete
'End If
'Next
'Application.DisplayAlerts = True
End Sub
Bookmarks