- Joined
- Jun 12, 2012
- Messages
- 2
- Reaction score
- 0
Hey everyone, new to the board and new to VBA. Wow this is a rather steep learning curve! Ok so here is my issue. I've created a workbook that has a hidden template sheet and a sheet that has just one big button. When the button is pressed, a macro runs that copies the hidden template, adds a new sheet, pastes the copy into the new sheet and names it based on user input. This works perfectly every time. In the VBAProject -> Microsoft Excel Objects -> ThisWorkBook I have written the following code for autocell select upon a carriage return:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
Target.Offset(0, 2).Select
ElseIf Target.Column = 4 Then
Target.Offset(0, 2).Select
ElseIf Target.Column = 6 Then
Target.Offset(2, -4).Select
End If
End Sub
My problem is that it works great on the hidden template sheet but not on any of the button created sheets. If I copy/paste the code into the VBA -> Microsoft Excel Objects -> (button created sheet name) it works great. Is there any way to automatically do this when the sheet is created or apply the ThisWorkBook code to the new sheet? This sheet is used as a master list of serial numbers that get scanned into it. I would also like to amend the code so that no duplicate serial numbers can be entered into any individual sheet, but not the entire workbook. I've tried EVERYTHING that I can Google. I'm rather frustrated by this. Any help would be GREATLY appreciated! Here is all macro coding that I'm using:
Sub CopyActiveSheet()
Application.ScreenUpdating = False
Dim Answer$
Dim Dte$
Dim NewName$
Dim Srt As Worksheet
Set Srt = ActiveSheet
Dte = Application.InputBox("What is today's date? (MMDDYYYY, no / or - please)")
Answer = Application.InputBox("Please enter the Sales Order Number.")
Sheets("Picking_Sheet").Range("G2") = Dte
Sheets("Picking_Sheet").Range("G3") = Answer
NewName = Sheets("Picking_Sheet").Range("G4")
ActiveWorkbook.Sheets.Add.Name = NewName
ActiveSheet.Move After:=Srt
Call Macro1
Sheets(NewName).Activate
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveSheet.Paste Destination:= _
Sheets(NewName).Range("A" & 1)
Application.CutCopyMode = False
Call Macro3
Columns("A:F").Select
ActiveSheet.PageSetup.PrintArea = Selection.Address
Call SetMargins
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
------------------------------------------------------------------------------------
Sub Add_Sheet()
Dim LastRow As Long
Dim Rng As Range
Dim NameNew As String
Application.ScreenUpdating = False
NameNew = ActiveSheet.Name
Sheets("Picking_Sheet").Visible = True
Sheets("Picking_Sheet").Activate
Sheets("Picking_Sheet").Range("G5") = LastRow
Range("A1:G45").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Picking_Sheet").Visible = False
Sheets(NameNew).Activate
Selection.EntireRow.Hidden = False
Rows("45:65536").Select
Selection.EntireRow.Hidden = False
Range("A65536").End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Range("A65536").End(xlUp).Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.EntireRow.Hidden = True
Columns("A:F").Select
ActiveSheet.PageSetup.PrintArea = Selection.Address
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
----------------------------------------------------------------------------
Sub Macro3()
Columns("H:H").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.EntireColumn.Hidden = True
ActiveWindow.SmallScroll Down:=30
Rows("46:46").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.EntireRow.Hidden = True
ActiveWindow.SmallScroll Down:=-39
End Sub
---------------------------------------------------------------------------------
Sub Macro1()
Sheets("Picking_Sheet").Visible = True
Sheets("Picking_Sheet").Select
Columns("A:G").Select
Selection.Copy
Sheets("Picking_Sheet").Visible = False
End Sub
--------------------------------------------------------------------------------
Sub SetMargins()
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.26)
.RightMargin = Application.InchesToPoints(0.21)
.TopMargin = Application.InchesToPoints(0.18)
.BottomMargin = Application.InchesToPoints(0.31)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlPortrait
.PaperSize = xlPaperLetter
.PrintErrors = xlPrintErrorsDisplayed
End With
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
Target.Offset(0, 2).Select
ElseIf Target.Column = 4 Then
Target.Offset(0, 2).Select
ElseIf Target.Column = 6 Then
Target.Offset(2, -4).Select
End If
End Sub
My problem is that it works great on the hidden template sheet but not on any of the button created sheets. If I copy/paste the code into the VBA -> Microsoft Excel Objects -> (button created sheet name) it works great. Is there any way to automatically do this when the sheet is created or apply the ThisWorkBook code to the new sheet? This sheet is used as a master list of serial numbers that get scanned into it. I would also like to amend the code so that no duplicate serial numbers can be entered into any individual sheet, but not the entire workbook. I've tried EVERYTHING that I can Google. I'm rather frustrated by this. Any help would be GREATLY appreciated! Here is all macro coding that I'm using:
Sub CopyActiveSheet()
Application.ScreenUpdating = False
Dim Answer$
Dim Dte$
Dim NewName$
Dim Srt As Worksheet
Set Srt = ActiveSheet
Dte = Application.InputBox("What is today's date? (MMDDYYYY, no / or - please)")
Answer = Application.InputBox("Please enter the Sales Order Number.")
Sheets("Picking_Sheet").Range("G2") = Dte
Sheets("Picking_Sheet").Range("G3") = Answer
NewName = Sheets("Picking_Sheet").Range("G4")
ActiveWorkbook.Sheets.Add.Name = NewName
ActiveSheet.Move After:=Srt
Call Macro1
Sheets(NewName).Activate
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveSheet.Paste Destination:= _
Sheets(NewName).Range("A" & 1)
Application.CutCopyMode = False
Call Macro3
Columns("A:F").Select
ActiveSheet.PageSetup.PrintArea = Selection.Address
Call SetMargins
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
------------------------------------------------------------------------------------
Sub Add_Sheet()
Dim LastRow As Long
Dim Rng As Range
Dim NameNew As String
Application.ScreenUpdating = False
NameNew = ActiveSheet.Name
Sheets("Picking_Sheet").Visible = True
Sheets("Picking_Sheet").Activate
Sheets("Picking_Sheet").Range("G5") = LastRow
Range("A1:G45").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Picking_Sheet").Visible = False
Sheets(NameNew).Activate
Selection.EntireRow.Hidden = False
Rows("45:65536").Select
Selection.EntireRow.Hidden = False
Range("A65536").End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Range("A65536").End(xlUp).Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.EntireRow.Hidden = True
Columns("A:F").Select
ActiveSheet.PageSetup.PrintArea = Selection.Address
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
----------------------------------------------------------------------------
Sub Macro3()
Columns("H:H").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.EntireColumn.Hidden = True
ActiveWindow.SmallScroll Down:=30
Rows("46:46").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.EntireRow.Hidden = True
ActiveWindow.SmallScroll Down:=-39
End Sub
---------------------------------------------------------------------------------
Sub Macro1()
Sheets("Picking_Sheet").Visible = True
Sheets("Picking_Sheet").Select
Columns("A:G").Select
Selection.Copy
Sheets("Picking_Sheet").Visible = False
End Sub
--------------------------------------------------------------------------------
Sub SetMargins()
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.26)
.RightMargin = Application.InchesToPoints(0.21)
.TopMargin = Application.InchesToPoints(0.18)
.BottomMargin = Application.InchesToPoints(0.31)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlPortrait
.PaperSize = xlPaperLetter
.PrintErrors = xlPrintErrorsDisplayed
End With
End Sub