Davis Henderson
New Member
Hi All. I have several macros that I am trying to run at the same time. Each one has the same function as seen below that updates the page number where the value is found. Some of the macros grab the correct page number, but some don't. I am printing where the value is found, and they are always correct. For example, if the file is found on C2 on the 9th page, often the return value is C2.1 instead of the correct C2.9. I know that is a lot of information, but if there is anything in my code that could explain the pageNum Variable not consistently updating correctly, it would be greatly appreciated!
Code:
Option Explicit
Sub Find_DatDenverExp()
'Denver Exp Macro
Dim datatoFind As String, MySheet As String, FV As String
Dim aSh As Worksheet, fSh As Worksheet
Dim firstResult As Range
Dim secondResult As Range
Dim rng As Range
Dim LeftCell As Range
Dim leftValue As String
Dim RowCount As Integer
Dim rw As Long
Dim counter As Integer
Dim sheetNumber As Integer
Dim sheetCount As Integer
Dim findValue As Range
sheetNumber = ActiveWorkbook.Sheets.Count
For counter = 1 To sheetNumber
Sheets(counter).Activate
'Denver Exp Macro
Set rng = Cells.Find(What:="Denver Exp", after:=Sheet1.Cells(1, 1), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False)
If Not rng Is Nothing Then
Exit For
Else
End If
Next counter
Set LeftCell = rng.Offset(0, -1)
leftValue = LeftCell.Value
'Ref. with one space after Ref.
If leftValue = "Ref. " Then
For rw = 1 To 10000
Set findValue = rng.Offset(rw, 0)
datatoFind = findValue
sheetCount = ActiveWorkbook.Sheets.Count
'Skipping the row that has a Zero
If Len(datatoFind) = 1 Then GoTo lastLine
'Stopping the macro where the values arer bold or grey
If Len(datatoFind) = 0 Or Not IsNumeric(datatoFind) Or findValue.Font.Bold Then Exit Sub
For counter = 1 To sheetCount
Sheets(counter).Activate
Set firstResult = Cells.Find(What:=datatoFind, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not firstResult Is Nothing Then
Set secondResult = Cells.FindNext(firstResult)
Debug.Print secondResult.Address
With secondResult
MySheet = IIf(InStr(secondResult.Parent.Name, "."), Split(secondResult.Parent.Name, ".")(0), Split(secondResult.Parent.Name)(0))
FV = MySheet & "." & pageNum8(secondResult)
End With
Else
End If
Next counter
With rng.Offset(rw, -1)
.Value = FV
.Font.Name = "Times New Roman"
.Font.Bold = True
.Font.Size = "10"
.Font.Color = vbRed
.HorizontalAlignment = xlRight
.VerticalAlignment = xlCenter
End With
lastLine:
Next rw
End If
End Sub
Function pageNum8(rng As Range)
Dim vA, hA
Dim iRow As Long, iCol As Long, I As Long
Dim pg8 As String
With rng.Parent
If .HPageBreaks.Count > 0 Then
ReDim hA(0 To .HPageBreaks.Count)
hA(0) = 1
For I = 1 To UBound(hA)
hA(I) = .HPageBreaks(I).Location.Row
Next
Else
ReDim hA(0 To 0)
hA(0) = 0
End If
If .VPageBreaks.Count > 0 Then
ReDim vA(0 To .VPageBreaks.Count)
vA(0) = 1
For I = 1 To UBound(vA)
vA(I) = .VPageBreaks(I).Location.Column
Next
Else
ReDim vA(0 To 0)
vA(0) = 0
End If
iRow = Application.Match(rng.Row, hA, 1)
iCol = Application.Match(rng.Column, vA, 1)
If .PageSetup.Order = xlDownThenOver Then
pg8 = (iCol - 1) * (.HPageBreaks.Count + 1) + iRow
Else
pg8 = (iRow - 1) * (.VPageBreaks.Count + 1) + iCol
End If
End With
pageNum8 = pg8
End Function
Last edited:
