Re: Simply Calling A Function From Button - Second Set of Eyes Please
If you don't mind, I have a few [very ignorant] questions. Still learning the framework I'm working in. Also, just to be clear, the code itself (gen30) is working when I play it inside the scripting window.
A quick bit: I have some background in web development, but it has been years since I practiced it (3-4). I am currently working in production control and have been asked to automate many of our schedules. This is the first real step toward that end.
Hi
Is this an ActiveX button for which the code is in the sheet module?
Yes. I have a Sheet5(Dashboard) where this button and the code [for the button] are located
I created a button with the same name and created a click event in the sheet module.
Code:
Option Explicit
Private Sub btnGen30_Click()
Gen30Day
End Sub
I then created a snippet of code to run called Gen30Day in a normal module, in order to keep it out the macro dialog box I set the module to private.
OK, here I have some questions or problems. In order to attempt to duplicate your trial, I opened my sheet.
My problem was discovered when I put Option Private Module on the top line. When I typed that in, it told me Compile Error: Option Private Module not permitted in an object module.
When I remove the module, it requests I put it back in. *very* helpful. This is where I came to the conclusion below.
On the worksheet(Code) for the Sub Gen30Day(), I have (General) in the top left most blank, showing the module I am working on in the top right. Is this incorrect? I was hoping to put all of my code in here eventually to re-use some of it. But I'm kinda guessing the code will need to go..where - attach to a worksheet itself?
Code:
Option Private Module
Sub Gen30Day()
MsgBox "Gen30Day running fine"
End Sub
This seemed to work, incidentally you shouldn't need to use the Call keyword.
HTH
=========================All of Code===================
This is still being written, so some of this may need to be eliminated, properly closed out, etc. I can fix those errors, but am also completely open to criticism if you see me going down the wrong path. Some of the snippets I toyed with using, then disposed of as I found better, faster or shorter ways to solve issues. I have not re-sued all of them (but will be taking them out as I continue to search for solutions to this issue. I am simply copying it in here for transparency.
This is in the sheet ThisWorkbook, and again top right drop down has (General)
Public Function Range_End(ws As String) As Long
Dim lRow As Long
Dim lCol As Long
Sheets(ws).Activate
lRow = Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Range_End = lRow
End Function
Sub CreateSheet(ByVal strSheetName As String, Optional ByVal rngHeader As Range)
Dim wsTest As Worksheet
Set wsTest = Nothing
On Error Resume Next
Set wsTest = ActiveWorkbook.Worksheets(strSheetName)
On Error GoTo 0
If wsTest Is Nothing Then
Worksheets.Add.Name = strSheetName
'MsgBox "Sheet " & strSheetName & " created."
End If
End Sub
Sub Erase30(ws1 As Worksheet, rngClear As Range)
'Remove Content
ws1.Select
rngClear.Clear
End Sub
Public Sub Gen30Day()
'WORKBOOKS
Dim wbCurrent As Workbook
'WORKSHEETS
Dim wsOrigin As Worksheet
Set wsOrigin = ActiveSheet
Dim wsData As Worksheet 'Name Worksheet gathering data from
Dim wsCopyTo As Worksheet 'Used for the new worksheet we are pasting into
Dim dtBeginDate As Date
Dim rngBurnDown As Range
Dim rngCell As Range
Dim rngNextAvailbleRow As Range
Dim rngClearData As Range
Dim c As Long
c = 1
Dim nClearDataLastRow As Long
Dim wsName As String
Dim stRev As String
Dim stRevChk As String
Dim stClearData As String
stRevChk = "Original"
dtToday = Date 'ERROR CHECKING MsgBox "dtToday: " & dtToday
dtBeginDate = DateAdd("d", -31, dtToday) 'ERROR CHECKING MsgBox "dtBeginDate: " & dtBeginDate
Set wbCurrent = ActiveWorkbook
Set wsData = Sheets("Data 2017") 'Define the worksheet with our data
wsName = "Data 30 Day"
'Now identify and select the new sheet to paste into
Set wsCopyTo = wbCurrent.Worksheets(wsName)
'Determine last row of Data in CopyTo & Create reference String to Create Dynamic Range
nClearDataLastRow = Range_End(wsName)
stClearData = "A3:I" & nClearDataLastRow
Set rngClearData = wsCopyTo.Range(stClearData)
Call Erase30(wsCopyTo, rngClearData)
'Dynamically define the range to the last cell.
'If we are not starting in A3, then change as appropriate
Set rngBurnDown = wsData.Range("A3:A" & wsData.Cells(Rows.Count, "A").End(xlUp).Row)
'Now loop through all the cells in the range
For Each rngCell In rngBurnDown.Cells
wsData.Select
'determine if date is appropriate
If rngCell.Value <> "" Then
If rngCell.Value >= dtBeginDate Then
If rngCell.Value <= dtToday Then
rngCell.EntireRow.Select
Selection.Copy
wsCopyTo.Activate 'changed from .select to .activate
If rngCell.Cells(c, 4).Value = stRevChk Then
Set rngNextAvailbleRow = wsCopyTo.Range("A1:A" & wsCopyTo.Cells(Rows.Count, "A").End(xlUp).Row)
Range("A" & rngNextAvailbleRow.Rows.Count + 1).Select
Worksheets(wsName).Paste 'jcp edit
End If 'end of version check
End If 'end if less than or today
End If 'End End Date If Statement
End If 'End Begin Date If Statement
Next rngCell
wsData.Select
wsData.Cells(1, 1).Select
'Can do some basic error handing here
'kill all objects
If IsObject(wbCurrent) Then Set wbCurrent = Nothing
If IsObject(wsData) Then Set wsData = Nothing
If IsObject(wsCopyTo) Then Set wsCopyTo = Nothing
If IsObject(rngBurnDown) Then Set rngBurnDown = Nothing
If IsObject(rngCell) Then Set rngCell = Nothing
If IsObject(rngNextAvailbleRow) Then Set rngNextAvailbleRow = Nothing
'begin where we end
wsOrigin.Activate
End Sub
Private Sub Workbook_Open()
End Sub