dellehurley
Board Regular
- Joined
- Sep 26, 2009
- Messages
- 171
- Office Version
- 365
- Platform
- Windows
This code works fine except I would like to create a hyperlink or any other way of jumping directly to cell.
Column A (currently the cell address to be linked too)
or
Column B (associated File Name) if this was turned into A hyperlink I would delete column A
Any help would be appreciated.
An example of what the result of the code looks like this...
Dannielle
Column A (currently the cell address to be linked too)
or
Column B (associated File Name) if this was turned into A hyperlink I would delete column A
Any help would be appreciated.
VBA Code:
Sub Check_Recs()
'Check that the are Rec No matches the no. of files people connected.
Dim DbWs As Worksheet
Dim ErrWs As Worksheet
Dim DbLastRow As Long
Dim ErrLastRow As Long
Dim ErrEmptyRow As Long
Dim RecNo As Variant
Dim RecSub As Variant
Dim NumFileName As Integer
Dim FileName As String
Dim DbRange As Range
Dim DbARange As Range
Dim i As Long
Set DbWs = ThisWorkbook.Sheets("Database")
Set ErrWs = ThisWorkbook.Sheets("CheckForErrors")
DbLastRow = DbWs.Cells(Rows.Count, "A").End(xlUp).Row
ErrLastRow = ErrWs.Cells(Rows.Count, "A").End(xlUp).Row
ErrEmptyRow = ErrWs.Cells(Rows.Count, "A").End(xlUp).Row + 1
Set DbRange = ThisWorkbook.Sheets("Database").Range("A2", ThisWorkbook.Sheets("Database").Range("L" & Application.Rows.Count).End(xlUp)) 'Dynamic Range "A:L
Set DbARange = ThisWorkbook.Sheets("Database").Range("A2", ThisWorkbook.Sheets("Database").Range("A" & Application.Rows.Count).End(xlUp)) 'Dynamic Range "A" no header
For i = 2 To DbLastRow
FileName = DbRange.Cells(i, 1).Value
RecNo = DbRange.Cells(i, 11).Value
RecSub = DbRange.Cells(i, 11).Value
NumFileName = Application.WorksheetFunction.CountIf(ThisWorkbook.Sheets("Database").Range _
("A2", ThisWorkbook.Sheets("Database").Range("L" & Application.Rows.Count).End(xlUp)), DbARange.Cells(i, 1).Value)
If NumFileName = RecNo Then
If RecSub = "" Then
ErrWs.Cells(ErrEmptyRow, 1).Value = DbRange.Cells(i, 1).Address
ErrWs.Cells(ErrEmptyRow, 2).Value = DbRange.Cells(i, 1).Value
ErrWs.Cells(ErrEmptyRow, 3).Value = DbRange.Cells(i, 6).Value
ErrWs.Cells(ErrEmptyRow, 4).Value = DbRange.Cells(i, 7).Value
ErrWs.Cells(ErrEmptyRow, 5).Value = DbRange.Cells(i, 11).Value
ErrWs.Cells(ErrEmptyRow, 6).Value = DbRange.Cells(i, 12).Value
ErrEmptyRow = ErrWs.Cells(Rows.Count, "A").End(xlUp).Row + 1
End If
Else
ErrWs.Cells(ErrEmptyRow, 1).Value = DbRange.Cells(i, 1).Address
ErrWs.Cells(ErrEmptyRow, 2).Value = DbRange.Cells(i, 1).Value
ErrWs.Cells(ErrEmptyRow, 3).Value = DbRange.Cells(i, 6).Value
ErrWs.Cells(ErrEmptyRow, 4).Value = DbRange.Cells(i, 7).Value
ErrWs.Cells(ErrEmptyRow, 5).Value = DbRange.Cells(i, 11).Value
ErrWs.Cells(ErrEmptyRow, 6).Value = DbRange.Cells(i, 12).Value
ErrEmptyRow = ErrWs.Cells(Rows.Count, "A").End(xlUp).Row + 1
End If
Next i
Call MessageBoxError2
End SubAn example of what the result of the code looks like this...
| Data_Entry_Form_ver_25 NEW EDIT.xlsm | ||||||||
|---|---|---|---|---|---|---|---|---|
| A | B | C | D | E | F | |||
| 1 | Cell Address | File Name | RIN | Full Name and YOB | Rec No | Rec Sub | ||
| 2 | $F$1152 | FIn3642.jpg | 7 | g | ||||
| 3 | $F$2333 | FIn2845.jpg | Roach, Cyril Anthony (b. 1920c) | 2 | b | |||
| 4 | $F$2374 | PBu2822.jpg | Scott, Matilda | 3 | c | |||
| 5 | $F$2486 | PBu2771.jpg | 6 | f | ||||
| 6 | $G$1152 | FIn3642.jpg | 7 | g | ||||
| 7 | $G$2486 | PBu2771.jpg | 6 | f | ||||
| 8 | $K$4944 | PIn0417.jpg | 231 | jpg | ||||
| 9 | $L$4740 | PMa0337.jpg | 157 | Smith, William Ian (b. 1922) | 5 | |||
| 10 | $L$4741 | PMa0337.jpg | 159 | Frith, John (b. 1870) | 5 | |||
CheckForErrors | ||||||||
Dannielle
