changing from every row to static

Status
Not open for further replies.

sassriverrat

Well-known Member
Joined
Oct 4, 2018
Messages
655
I'd like to change the following code so that instead of going every row, it will allow the button on that row to run the code for just that row (if this makes sense). Basically I have two macros- one that checks every row (in a certain column) for data and if something is there, makes a button in "A" column of that row to run a macro. The second macro (below) takes the info from that row and runs a macro but is currently written to go run every row. I want to make the macro below work for just one row (but I don't want to name the row number in the code because I have hundreds of rows to do this for). Anyone have ideas?

Thanks!

Code:
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
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"
Duplicate post
Please do not post the same question multiple times. All clarifications, follow-ups, and bumps should be posted back to the original thread.
Per forum rules, posts of a duplicate nature will be locked or deleted (rule 12 here: Forum Rules).

As you have a response on the other thread, I've closed this one.
 
Last edited:
Upvote 0
Status
Not open for further replies.

Forum statistics

Threads
1,223,894
Messages
6,175,254
Members
452,623
Latest member
Techenthusiast

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top