O
Owl
Hi,
Ive set up a macro where i can pick a promotion from a drop down list and it
pulls out all of the products which ran that promotion from another sheet.
Ive set all my variables up as integers so this could be the issue.
I want to be able to put other drop down menus in so i can cut the data in
any which way.....so i wanted to make sure this code was perfect....
This is my code - hopefully not too much info for anyone out there but
thought it might help more than me trying to explain...
Option Explicit
Option Compare Text
Public Promotion As String
Dim NoRows As Integer 'Number of rows with data in "Total Sales"
Dim Counter As Integer 'Keeps count of rows checked
Dim SalesRow As Integer 'Indicates which row is being copied
Dim NewSalesRow As Integer 'Indicates which row in new sheet is the data
going
Dim Uplift As Integer 'Calculates the Uplift for each transaction
Dim TotalUplift As Integer 'Holds the total Uplift for each Promotion
Sub salesmain()
On Error GoTo Errorhandler
'Err.Raise 11
Application.ScreenUpdating = False
Call CreateSheet
Call CopyHeadings
Call CopySalesRecords
Call formatcolumns
Exit Sub
Errorhandler:
If Err.Number = 6 Then
MsgBox "You entered the wrongname" & vbCrLf & _
"The system is reseting" & vbCrLf & "Make sure you enter a correct
name" _
Application.DisplayAlerts = False
Sheets(Promotion).Delete
Application.DisplayAlerts = True
Else
MsgBox "Unexpected error. type :" & Err.Number & vbCrLf & vbCrLf & _
Err.Description & vbCrLf & vbCrLf & "Contact the helpdesk"
End If
End Sub
Sub CreateSheet()
'
' CreateSheet Macro
'
Call DeleteSheetIfExists
Sheets.Add After:=Sheets(Sheets.Count)
'adds the sheet after the last count
ActiveSheet.Name = Promotion
End Sub
Sub DeleteSheetIfExists()
Dim SheetVar As Worksheet
For Each SheetVar In ActiveWorkbook.Worksheets
'Debug.Print SheetVar.Name
If SheetVar.Name = Promotion Then
Application.DisplayAlerts = False
SheetVar.Delete
Application.DisplayAlerts = True
Exit For
End If
Next SheetVar
End Sub
Sub CopyHeadings()
'
' CopyHeadings Macro
'
'
Sheets("Marketing Summary").Range("A1:Q1").Copy
Sheets(Promotion).Select
Range("A1").Select
ActiveSheet.Paste
Range("A10").Select
Application.CutCopyMode = False
End Sub
Sub formatcolumns()
Sheets(Promotion).Select
Columns("A:Q").EntireColumn.AutoFit
Range("A1").Select
End Sub
Sub CopySalesRecords()
SalesRow = 2
NewSalesRow = 2
Sheets("Marketing Summary").Select
Range("A2").Select
NoRows = ActiveCell.CurrentRegion.Rows.Count
For Counter = 1 To NoRows
If Cells(SalesRow, 2) = Promotion Then
Range(Cells(SalesRow, 1), Cells(SalesRow, 17)).Copy
Sheets(Promotion).Select
Cells(NewSalesRow, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Call calcTotals
NewSalesRow = NewSalesRow + 1
Sheets("Marketing Summary").Select
End If
SalesRow = SalesRow + 1
Next Counter
Call AddTotals
End Sub
Sub calcTotals()
'Cells(NewSalesRow, 13) = Uplift
TotalUplift = TotalUplift + Cells(NewSalesRow, 13)
End Sub
Sub AddTotals()
Sheets(Promotion).Select
NewSalesRow = NewSalesRow + 1
Cells(NewSalesRow, 12) = "Totals"
Cells(NewSalesRow, 13) = TotalUplift
Rows(NewSalesRow).Font.Bold = True
End Sub
Ive set up a macro where i can pick a promotion from a drop down list and it
pulls out all of the products which ran that promotion from another sheet.
Ive set all my variables up as integers so this could be the issue.
I want to be able to put other drop down menus in so i can cut the data in
any which way.....so i wanted to make sure this code was perfect....
This is my code - hopefully not too much info for anyone out there but
thought it might help more than me trying to explain...
Option Explicit
Option Compare Text
Public Promotion As String
Dim NoRows As Integer 'Number of rows with data in "Total Sales"
Dim Counter As Integer 'Keeps count of rows checked
Dim SalesRow As Integer 'Indicates which row is being copied
Dim NewSalesRow As Integer 'Indicates which row in new sheet is the data
going
Dim Uplift As Integer 'Calculates the Uplift for each transaction
Dim TotalUplift As Integer 'Holds the total Uplift for each Promotion
Sub salesmain()
On Error GoTo Errorhandler
'Err.Raise 11
Application.ScreenUpdating = False
Call CreateSheet
Call CopyHeadings
Call CopySalesRecords
Call formatcolumns
Exit Sub
Errorhandler:
If Err.Number = 6 Then
MsgBox "You entered the wrongname" & vbCrLf & _
"The system is reseting" & vbCrLf & "Make sure you enter a correct
name" _
Application.DisplayAlerts = False
Sheets(Promotion).Delete
Application.DisplayAlerts = True
Else
MsgBox "Unexpected error. type :" & Err.Number & vbCrLf & vbCrLf & _
Err.Description & vbCrLf & vbCrLf & "Contact the helpdesk"
End If
End Sub
Sub CreateSheet()
'
' CreateSheet Macro
'
Call DeleteSheetIfExists
Sheets.Add After:=Sheets(Sheets.Count)
'adds the sheet after the last count
ActiveSheet.Name = Promotion
End Sub
Sub DeleteSheetIfExists()
Dim SheetVar As Worksheet
For Each SheetVar In ActiveWorkbook.Worksheets
'Debug.Print SheetVar.Name
If SheetVar.Name = Promotion Then
Application.DisplayAlerts = False
SheetVar.Delete
Application.DisplayAlerts = True
Exit For
End If
Next SheetVar
End Sub
Sub CopyHeadings()
'
' CopyHeadings Macro
'
'
Sheets("Marketing Summary").Range("A1:Q1").Copy
Sheets(Promotion).Select
Range("A1").Select
ActiveSheet.Paste
Range("A10").Select
Application.CutCopyMode = False
End Sub
Sub formatcolumns()
Sheets(Promotion).Select
Columns("A:Q").EntireColumn.AutoFit
Range("A1").Select
End Sub
Sub CopySalesRecords()
SalesRow = 2
NewSalesRow = 2
Sheets("Marketing Summary").Select
Range("A2").Select
NoRows = ActiveCell.CurrentRegion.Rows.Count
For Counter = 1 To NoRows
If Cells(SalesRow, 2) = Promotion Then
Range(Cells(SalesRow, 1), Cells(SalesRow, 17)).Copy
Sheets(Promotion).Select
Cells(NewSalesRow, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Call calcTotals
NewSalesRow = NewSalesRow + 1
Sheets("Marketing Summary").Select
End If
SalesRow = SalesRow + 1
Next Counter
Call AddTotals
End Sub
Sub calcTotals()
'Cells(NewSalesRow, 13) = Uplift
TotalUplift = TotalUplift + Cells(NewSalesRow, 13)
End Sub
Sub AddTotals()
Sheets(Promotion).Select
NewSalesRow = NewSalesRow + 1
Cells(NewSalesRow, 12) = "Totals"
Cells(NewSalesRow, 13) = TotalUplift
Rows(NewSalesRow).Font.Bold = True
End Sub