Finding Ranges Based on Headers

[SamuelS]

So I have a bunch of different excel documents that all have the same info under the same headers, but they are not all in the same cells (So in one it might start with part names in cell A5 and another might start with Part number in Cell A2)


I would like to be able to get rid of my current method of asking for input to fix the code and instead run some sort of "Find" feature to find the headers such as Part, Electrical Number, or Url and automatically generate where the range of cells are so all the user has to do is run the program and wait.

Option Explicit

Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" (ByVal pCaller As Long, _
ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Dim Ret As Long
'This is where the images will be saved. Change as applicable
Const FolderName As String = "C:\Users\StevensonS\Documents"

Private Const ERROR_SUCCESS As Long = 0

 Public Function DownloadFile(ByVal sURL As String, ByVal sLocalFile As String) As Boolean
 Dim lngRetVal As Long
 DownloadFile = URLDownloadToFile(0&, sURL, sLocalFile, 0&, 0&) = ERROR_SUCCESS
 End Function
 

Sub FinalV2()

' Declarations
Dim rng As Range
Dim ws As Worksheet
Dim LastRow As Long, i As Long
Dim strPath As String
Dim Row As Integer
Dim Name As String
Dim HTML As String
Dim Tag As String
Dim Link As String
Dim Jump As Integer
Dim Jump2 As Integer
Dim Jump3 As Integer
Dim Cell As Range
Dim Pic As Picture
Dim MyFile As String
Dim fnum As String
Dim url As String
Dim Names As String


'User Inputs
Row = Application.InputBox("What Row Does the Data Start on?", "Input Box Text", Type:=2)
Name = Application.InputBox("What Column Letter Are the Part Names On?", "Input Box Text", Type:=2)
Tag = Application.InputBox("What Column Letter Are the Tag codes on?", "Input Box Text", Type:=2)
HTML = Application.InputBox("What Column Letter Are the HTML codes on?", "Input Box Text", Type:=2)
Jump2 = ActiveSheet.Range("" & HTML & Row).Column - ActiveSheet.Range("" & Name & Row).Column
Jump = ActiveSheet.Range("" & Tag & Row).Column - ActiveSheet.Range("" & Name & Row).Column

Set rng = Application.InputBox("Select the Range of the URLs.", "Range Select", Type:=8)
Jump3 = rng.Column - ActiveSheet.Range("" & Name & Row).Column
'prevents refresh and saves time
Application.ScreenUpdating = False

    Set ws = ActiveSheet
    
    'counts the number of populated rows
    LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
    
    
     For Each Cell In rng
            With Cell
                DownloadFile "" & Cell.Value, "C:\temp\" & Cell.Offset(, -Jump3).Value & "QR.png"
            End With
     Next Cell
      
    
'Resets Range to the top of the Spreadsheet
Range("" & Name & Row).Activate
'Runs down the document until it runs into an empty cell
'saves the text in the html cell and named after the part name
Do While Not IsEmpty(ActiveCell.Offset(0, 1))
    MyFile = ActiveCell.Value & " Tag.html"
    fnum = FreeFile()
    Open MyFile For Output As fnum
    Print #fnum, ActiveCell(1, Jump + 1)
Close #fnum
'iterates the active cell one row down
ActiveCell.Offset(1, 0).Select
Loop
'Resets Range to the top of the Spreadsheet
Range("" & Name & Row).Activate
Do While Not IsEmpty(ActiveCell.Offset(0, 1))
    MyFile = ActiveCell.Value & ".html"
    fnum = FreeFile()
    Open MyFile For Output As fnum
    Print #fnum, ActiveCell(1, Jump2 + 1)
Close #fnum
'iterates the active cell one row down
ActiveCell.Offset(1, 0).Select
Loop
'allows the screen to refresh and show the new cell data
Application.ScreenUpdating = True
'Lets the user know the program is finished
MsgBox "Done"
End Sub

Also, I'm new to VBA but not to coding and I can tell my code is pretty sloppy so if you have any ideas how to clean it up I would appreciate it.

Thank You,
-Sam Stevenson

 

[AlphaFrog]

Here's a good step-by-step guide on the .Find method.

Excel VBA Find Method

 

[SamuelS]

Thanks that helped a lot!