creating a button and then adding the code

[sassriverrat]

I'd like a piece of code that can create a button that perfectly covers cell A1 and then runs the following piece of code for only that row, not every row as the code was originally designed. Thank you for your help. Also, and the important part, it has to check if there are contents in column I of that row (so starting in on row 4, make a button that covers A4 if there are contents in Cell I4, and then that button will run the code below but for only that row, not every row. thanks again!



I will be placing this in the "thisworkbook" piece to run as soon as the workbook opens such that every time the workbook opens, excel will be making these buttons based on what
"i" cells are populated.

Sub DemoTestDate()'First time initializing Code
Dim s As String
Dim name As String
Dim resp As Integer
Dim bdate As String
Dim ddate As String
name = Sheets("Notes").Range("N4")
bdate = Sheets("Developer").Range("A36")
ddate = Sheets("Developer").Range("C34")


s = GetSetting("DemoTest", "Registration", "Username")
If s = "" Then
        Sheets("Developer").Unprotect Password:=Worksheets("Developer").Range("B15:E15").Value
        Sheets("Developer").Range("B34:F34").ClearContents
        's = InputBox("Welcome to the " & namer & " Voyage Reporting System." & vbCrLf & "Please input the appropriate name to initialize the system for the first time." & vbCrLf & vbCrLf & "Note: this information can be modified later by clicking on the [Developer] button.", namer, "Bridge")
        'UserForm17.Show
        s = cInputBox()
        MsgBox s
        
        If s <> "" Then
            's = cInputBox()
            Sheets("Developer").Unprotect Password:=Worksheets("Developer").Range("B15:E15").Value
            Sheets("Developer").Range("B34") = s
            SaveSetting "DemoTest", "Registration", "Username", s
            Sheets("Notes").Visible = xlSheetVisible
            Sheets("Notes").Select
            Sheets("Developer").Range("C36") = Date
            'If s <> "" Then MsgBox "Welcome to the " & name & " Voyage Reporting System." & vbCrLf & "Please input the appropriate data to initialize the system for the first time." & vbCrLf & vbCrLf & "Note: this information can be modified later by clicking on the [Developer] button.", vbOKOnly, name
            Application.Visible = True
            Sheets("Developer").Protect Password:=Worksheets("Developer").Range("B15:E15").Value
        End If
End If
End Sub

 

[Yongle]

VBA below should create a button the same size as cell in column A.
Clicking on the button runs MacroX

1. Use a NEW workbook with ONE sheet for testing
- put values in some cells in column I2. Add code as instructed...

in STANDARD module

Sub MacroX()
    MsgBox "Hello"
End Sub

Sub AddButtons()
    Dim Cel As Range, B As Range, Ws As Worksheet: Set Ws = ActiveSheet
    Ws.Buttons.Delete
    For Each Cel In Ws.Range("I1", Ws.Cells(Rows.Count, "I").End(xlUp))
        If Cel <> "" Then
            Set B = Cel.Offset(, -8)
            With ActiveSheet.Buttons.Add(B.Left, B.Top, B.Width, B.Height)
                .OnAction = "MacroX"
                .Caption = "Hi"
                .name = "Btn_" & B.Address(0, 0)
            End With
        End If
    Next Cel
End Sub

3. Test by running AddButtons (to create the buttons) and then click on a button (to run MacroX)

Q1 Does it do what you want ?
Q2 What requires modifying in your code ? Which lines should be modified ?

 

[sassriverrat]

Holy Cow!
@Yongle, that's amazing. Exactly what I wanted. worked like a champ. thank you!!!

So to answer your questions, here's my plan:

1. I was thinking of either calling this when the workbook opens (which I now how to do) or calling it as a change event (which I can somewhat do with some meddling of my own but might have to ask for help if I crash myself).

2. I will tweak this code to set the activesheet to actually be the "Background" sheet.

3. My current code for downloading the files (these are "download" buttons) works but it goes line by line and checks each row. my plan was to delete the "next rw" piece so it would just check the same row as the button. code below.

4. I have no idea why I posted the piece of code above that I did....it's not the one I meant to and was for a totally different project....thank you!

Sub Download()Dim URL As String
Dim tstamp As String
Dim Folder0 As String
Dim Folder1 As String
Dim Namer As String
Dim Date0 As String
Dim Date1 As String
Dim Date2 As String
Dim Date3 As String
Dim LocalFilePath As String
Dim TempFolderOLD As String
Dim Divider As String
Dim TempFileNEW As String
Dim Finalname As String
Dim DownloadStatus As Long
Dim LastRow As Long
Dim btn As Shape
Dim rw As Long
Dim MyFSO As FileSystemObject
Set MyFSO = New Scripting.FileSystemObject
    
    ' find last row of data in column B on 'Background'
    LastRow = Sheets("Background").Range("B" & Rows.Count).End(xlUp).Row


    ' loop through rows on 'Background'
    'For rw = 4 To .Range("B" & Rows.Count).End(xlUp).Row
    For rw = 4 To Sheets("Background").Range("B" & Rows.Count).End(xlUp).Row
With Sheets("Background")
    Namer = .Range("B" & rw)    'Pub name
    URL = .Range("I" & rw)      'URL to download
    Date0 = .Range("C" & rw)    'Week #
    Date1 = .Range("E" & rw)    'Year #
    Date2 = .Range("G2")        'Base Week
    Date3 = .Range("I2")        'Base Year
    Divider = .Range("D" & rw)  '\
End With
With Sheets("Setup")
    Folder0 = .Range("B5") 'temp file
    Folder1 = .Range("B7") 'permanent file
End With
TempFolderOLD = Environ("Userprofile") & "\" & Folder0
tstamp = Format(Now, "mm-dd-yyyy")
TempFileNEW = TempFolderOLD & tstamp & "\" & Namer & ".pdf"
LocalFilePath = Environ("Userprofile") & "\" & Folder1 & "\"
Finalname = Namer & ".pdf"
    
'If these criteria are met, let's begin the download tree
    If Date0 = Date2 Then
        If Date1 <> Date3 Then
       
'Let's assign everything to the temp folder
    'Begin by clearing any possible undeleted/corrupted files from my "temp" folder
        If Len(Dir(TempFolderOLD)) <> "" Then Kill (TempFolderOLD)
    'Make a new temp folder
        If Len(Dir(TempFolderOLD)) = "" Then MkDir (TempFolderOLD)
    'Attempt download to the temp folder
        DownloadStatus = URLDownloadToFile(0, URL, TempFileNEW, 0, 0)
    'Check for proper download
        If DownloadStatus = 0 Then
        'Delete the old files
            Kill (LocalFilePath)
        'Save temp files to replace old files
            'TempFileNEW.SaveAs Filename:=LocalFilePath, FileFormat:=xlTypePDF
            MyFSO.CopyFile Source:=TempFileNEW, Destination:=LocalFilePath & Finalname
        'Now delete temp files
            If MyFSO.FolderExists(TempFolderOLD) Then MyFSO.DeleteFolder (TempFolderOLD)
        'Now update excel sheet to show download passed
            MsgBox "File Downloaded. Check in this path: " & LocalFilePath
                With Sheets("Background")
                    .Range("F" & rw) = tstamp
                    .Range("G" & rw) = "SAT"
                    .Range("C" & rw) = Format(Now, "ww", vbWednesday)
                    .Range("D" & rw) = "\"
                    .Range("E" & rw) = Format(Now, "yy")
                'date formating
                    .Range("C" & rw).HorizontalAlignment = xlRight
                    .Range("D" & rw).HorizontalAlignment = xlGeneral
                    .Range("E" & rw).HorizontalAlignment = xlLeft
                    .Range("F" & rw) = Format(Now, "dd-mmm-yyyy")
                End With
    'If download failed, update excel to show- old files should NOT have been deleted yet but the temp file should be deleted
        Else:
            MsgBox "Download File Process Failed"
            Sheets("Background").Range("G" & rw) = "FAIL"
            Kill (TempFolderOLD)
        End If
    'If the original criteria were met and the download was not necessary, say so
    Else: MsgBox "The most up to date pub has been downloaded"
    End If
    End If
    Next rw
End Sub