Results 1 to 2 of 2

Thread: changing from every row to static
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    Board Regular
    Join Date
    Oct 2018
    Posts
    502
    Post Thanks / Like
    Mentioned
    2 Post(s)
    Tagged
    0 Thread(s)

    Default changing from every row to static

    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
    0 0
     

  2. #2
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    28,158
    Post Thanks / Like
    Mentioned
    470 Post(s)
    Tagged
    47 Thread(s)

    Default Re: changing from every row to static

    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 by Fluff; May 3rd, 2019 at 08:30 AM.
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 365 on Win 10
    0 0
     

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •