mdavontuur25
New Member
- Joined
- May 5, 2011
- Messages
- 11
Hi Guys
I have a spreadsheet with a button on it, the button has the following macro attached to it.
Sub report_creator()
Dim name As Worksheet
'Cancel screen updating
Application.ScreenUpdating = False
'Adding new sheet
Set name = Sheets.Add
name.name = "Report"
'Rename new sheet
'Adding Report Headings
Range("A1") = "Account"
Range("B1") = "Date"
Range("C1") = "Reference"
Range("D1") = "Contra"
Range("E1") = "Description"
Range("F1") = "Debit"
Range("G1") = "Credit"
Range("H1") = "Cumulative"
'Centre Headings
Range("A1:H1").Select
With Selection
.HorizontalAlignment = xlCenter
End With
'Underline Headings
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
'Resize Column Width
Range("A:D").ColumnWidth = 9
Range("E:E").ColumnWidth = 20
Range("F:H").ColumnWidth = 11
'Select Starting Cell
Range("A3").Select
'Page Setup for printing purposes
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.393700787401575)
.RightMargin = Application.InchesToPoints(0.393700787401575)
.TopMargin = Application.InchesToPoints(0.78740157480315)
.BottomMargin = Application.InchesToPoints(0.78740157480315)
.CenterHorizontally = True
End With
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Advance filter to process data to report
Dim LR As Long
With Sheets("cbpay")
LR = .Range("B" & Rows.Count).End(xlUp).Row
.Range("B8:M" & LR).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("A1:G1"), Unique:=False
End With
'Remove lines
Rows("2:3").Select
Selection.Insert Shift:=xlDown
Rows("4:4").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
'Sort ascending per Column A then Column B
Selection.Sort Key1:=Range("A4"), Order1:=xlAscending, Key2:=Range("B4") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
Range("A4").Select
End Sub
The macro works brilliantly, except the button can only be pressed once when the sheet "Report" is created.
Ideally I want the button to be pressed then it must extract the information to the Report sheet and delete the information on the "cbpay" sheet. when new information is added to the cbpay sheet it must update the information on the Report sheet.
Thank you in advance...
I have a spreadsheet with a button on it, the button has the following macro attached to it.
Sub report_creator()
Dim name As Worksheet
'Cancel screen updating
Application.ScreenUpdating = False
'Adding new sheet
Set name = Sheets.Add
name.name = "Report"
'Rename new sheet
'Adding Report Headings
Range("A1") = "Account"
Range("B1") = "Date"
Range("C1") = "Reference"
Range("D1") = "Contra"
Range("E1") = "Description"
Range("F1") = "Debit"
Range("G1") = "Credit"
Range("H1") = "Cumulative"
'Centre Headings
Range("A1:H1").Select
With Selection
.HorizontalAlignment = xlCenter
End With
'Underline Headings
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
'Resize Column Width
Range("A:D").ColumnWidth = 9
Range("E:E").ColumnWidth = 20
Range("F:H").ColumnWidth = 11
'Select Starting Cell
Range("A3").Select
'Page Setup for printing purposes
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.393700787401575)
.RightMargin = Application.InchesToPoints(0.393700787401575)
.TopMargin = Application.InchesToPoints(0.78740157480315)
.BottomMargin = Application.InchesToPoints(0.78740157480315)
.CenterHorizontally = True
End With
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Advance filter to process data to report
Dim LR As Long
With Sheets("cbpay")
LR = .Range("B" & Rows.Count).End(xlUp).Row
.Range("B8:M" & LR).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("A1:G1"), Unique:=False
End With
'Remove lines
Rows("2:3").Select
Selection.Insert Shift:=xlDown
Rows("4:4").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
'Sort ascending per Column A then Column B
Selection.Sort Key1:=Range("A4"), Order1:=xlAscending, Key2:=Range("B4") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
Range("A4").Select
End Sub
The macro works brilliantly, except the button can only be pressed once when the sheet "Report" is created.
Ideally I want the button to be pressed then it must extract the information to the Report sheet and delete the information on the "cbpay" sheet. when new information is added to the cbpay sheet it must update the information on the Report sheet.
Thank you in advance...