CODEWITHSUNDEEP
excelvba
Monika
Monika

Reputation: 74

Selecting column range with specific header

I have a macro code but it runs on specific column and on range of 500 only. I wish it should dynamically select column of header 'PRODUCTS' is present. if possible can we increase the limit of 500 to all the data present in column 'PRODUCTS'.

Sub Pats()

myCheck = MsgBox("Do you have Patent Numbers in Column - B ?", vbYesNo)
    If myCheck = vbNo Then Exit Sub

endrw = Range("B500").End(xlUp).Row

Application.ScreenUpdating = False

For i = 2 To endrw
PatNum = Cells(i, 2).Value
If Left(Cells(i, 2), 2) = "US" Then
link = "http://www.google.com/patents/" & PatNum
Cells(i, 2).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http://www.google.com/patents/" & PatNum, ScreenTip:="Click to View", TextToDisplay:=PatNum
With Selection.Font
        .Name = "Arial"
        .Size = 10
End With

ElseIf Left(Cells(i, 2), 2) = "EP" Then
link = "http://www.google.com/patents/" & PatNum
Cells(i, 2).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http://www.google.com/patents/" & PatNum, ScreenTip:="Click to View", TextToDisplay:=PatNum
With Selection.Font
        .Name = "Arial"
        .Size = 10
End With

End If
Next i
End Sub

Upvotes: 1

Views: 401

Answers (2)

Mark Farmiloe
Mark Farmiloe

Reputation: 396

I would first extract the link building part into a separate subroutine ...

Sub AddLink(c As Range)
  Dim link As String
  Dim patNum As String
  Dim test As String
    patNum = c.Value
    test = UCase(Left(patNum, 2))
    If test = "US" Or test = "EP" Then
        link = "http://www.google.com/patents/" & patNum
    Else
        link = "http://www.www.hyperlink.com/" & patNum
    End If
    c.Hyperlinks.Add Anchor:=c, Address:=link, ScreenTip:="Click to View", TextToDisplay:=patNum
    With c.Font
        .Name = "Arial"
        .Size = 10
    End With
End Sub

Then I would add a function to find the column...

Function FindColumn(searchFor As String) As Integer
  Dim i As Integer
    'Search row 1 for searchFor
    FindColumn = 0
    For i = 1 To ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column
        If ActiveSheet.Cells(1, i).Value = searchFor Then
            FindColumn = i
            Exit For
        End If
    Next i
End Function

Finally I would put it all together ...

Sub Pats()
  Dim col As Integer
  Dim i As Integer
    col = FindColumn("PRODUCTS")
    If col = 0 Then Exit Sub
    For i = 2 To ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
        AddLink ActiveSheet.Cells(i, col)
    Next i
End Sub

I'll admit I have to use SO to remind myself how to get the last used cell on a worksheet (see Find Last cell from Range VBA).

Upvotes: 1

Calico
Calico

Reputation: 416

The code below will find which column has the header PRODUCTS and then find the last row in that column and store it in variable lrProdCol.

Sub FindProductLR()
    Dim col As Range
    Dim endrw As Long

    Set col = Rows(1).Find("PRODUCTS")
    If Not col Is Nothing Then
        endrw = Cells(Rows.count, col.Column).End(xlUp).Row
    Else
        MsgBox "The 'PRODUCTS' Column was not found in row 1"
    End If
End Sub

So replace the following bit of code

myCheck = MsgBox("Do you have Patent Numbers in Column - B ?", vbYesNo)
    If myCheck = vbNo Then Exit Sub

endrw = Range("B500").End(xlUp).Row

With the lines above. Hope that helps

Upvotes: 0

Related Questions