Applying a macro to mulitple cells within a column

[hellenv]

Hello,
I am created a simple macro that allows me:
- Search for a column header in Sheet1
- Go to the first cell underneath that column header
- Copy the value within that cell
- Search for that cell in Sheet2
- Copy the cell location of that value
- Go back to the cell in Sheet1 and hyperlink the cell location (from sheet2)

How do I...
- copy the macro across all cells within the column in Sheet1
- have the macro skip "Blank" cells and move to the next populated cell within the column?

Thanks!!

Hellen

 

[Trebor76]

Hi hellenv,

Welcome to MrExcel!!

Could you post the macro you're using? It will make it easier to adapt it to your needs.

Thanks,

Robert

 

[hellenv]

Cells.Find(What:="Gap Req Id", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Range("P5").Select
Selection.Copy
Range("J6").Select
Sheets("Gap Ref").Select
Cells.Find(What:="G12.BR.009", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Application.CutCopyMode = False
Sheets("Test").Select
Range("P5").Select

 

[JLGWhiz]

see if this will work.

Sub makeHyperlinks()
Dim sh1 As Worksheet, sh2 As Worksheet, c As Range, fn As Range, fnd As Range, colNm As String, col As Long
Set sh1 = Sheets("Sheet1") 'Edit sheet name
Set sh2 = Sheets("Sheet2") 'Edit sheet name
colNm = InputBox("Enter the Header Title to search for.", "HEADER TITLE")
    If colNm = "" Then
        MsgBox "Invalid Entry, procedure will teminate"
        Exit Sub
    End If
Set fn = sh1.Rows(1).Find(colNm, , xlValues, xlWhole)
    If Not fn Is Nothing Then
        col = fn.Column
        For Each c In sh1.Range(sh1.Cells(2, col), sh1.Cells(Columns.Count, col).End(xlUp))
            Set fnd = sh2.UsedRange.Offset(1).Find(c.Value, , xlValues, xlWhole)
            If Not fnd Is Nothing Then
                c.Hyperlinks.Add c, "", "Sheet2!" & fnd
            End If
        Next
    End If
End Sub

Be sure to change the sheet names to your sheet's names.