I need your help in order to fix this code. Objective of this code is set a range. find the first "To Date", then select all the cells under "To Date" paste the value in the previous cells (for example the first "To Date" is in cell F4 contains value from F5:F"N"(N=last row) then paste F5:F"N" values in E5:E"N", then go to the next To Date.
The problem I am facing in this code is that
the Code does not select the last row in under the "To Date" (except for the first time)
the code runs in infinite loop does not stop after the last "To Date"
Sub FindAddressColumn() Dim twb As ThisWorkbook Dim ws As Worksheet Dim lastRow As Long Dim LastCol As Long Dim lr As Long Dim getLastCell As Range Dim firstAddress As String Dim rngAddress As Range Const strFindMe As String = "To Date" Set twb = ThisWorkbook For Each ws In twb.Worksheets If ws.Name = "QCR Summary" Then lastRow = ws.Cells.Find("*", ws.Cells(1, 1), xlFormulas, xlPart, xlByRows, _ xlPrevious).Row LastCol = ws.Cells.Find("*", ws.Cells(1, 1), xlFormulas, xlPart, xlByColumns, _ xlPrevious).Column Set getLastCell = ws.Cells(lastRow, LastCol) With ws.Range("A1", getLastCell) Set rngAddress = .Find(What:=strFindMe, LookIn:=xlValues) If rngAddress Is Nothing Then Exit Sub End If firstAddress = rngAddress.Address Do Set rngAddress = .FindNext(rngAddress) Range(rngAddress, rngAddress.End(xlDown)).Select 'MsgBox rngAddress.Address Loop While Not rngAddress Is Nothing And rngAddress <> firstAddress End With End If Next ws End Sub
Because you named your variable rngAddress
the names suggests that the variable contains an address string while it actually contains a Range
object.
Then you compare rngAddress <> firstAddress
but if you have a look at your variable declarations
Dim firstAddress As String
Dim rngAddress As Range
You see that you compare a Range
object with a String
which cannot work properly. Because rngAddress
is a range object it defaults to rngAddress.Value
so you actually compare the value of the cell rngAddress
with an address string firstAddress
.
Replace
Loop While Not rngAddress Is Nothing And rngAddress <> firstAddress
with
Loop While rngAddress.Address <> firstAddress
Note that you can omit the part Not rngAddress Is Nothing
here in the loop because that can never happen. If it would be Nothing
then it would have already Exit Sub
in the step earlier where you checked If rngAddress Is Nothing Then
.
Also Dim twb As ThisWorkbook
this should error because it must be Dim twb As Workbook
.
Finally your loop is a bit unnecessary, because you can access your sheet named QCR Summary
directly without looping throug all worksheets. Which would be much quicker:
Option Explicit
Public Sub FindAddressColumn()
Const strFindMe As String = "To Date"
Dim twb As Workbook
Set twb = ThisWorkbook
Dim ws As Worksheet
On Error Resume Next
Set ws = twb.Worksheets("QCR Summary")
On Error GoTo 0
If ws Is Nothing Then
MsgBox "Worksheet 'QCR Summary' does not exist."
Exit Sub
End If
Dim lastRow As Long
lastRow = ws.Cells.Find("*", ws.Cells(1, 1), xlFormulas, xlPart, xlByRows, _
xlPrevious).Row
Dim LastCol As Long
LastCol = ws.Cells.Find("*", ws.Cells(1, 1), xlFormulas, xlPart, xlByColumns, _
xlPrevious).Column
Dim getLastCell As Range
Set getLastCell = ws.Cells(lastRow, LastCol)
With ws.Range("A1", getLastCell)
Dim rngAddress As Range
Set rngAddress = .Find(What:=strFindMe, LookIn:=xlValues)
If rngAddress Is Nothing Then
Exit Sub
End If
Dim firstAddress As String
firstAddress = rngAddress.Address
Do
Set rngAddress = .FindNext(rngAddress)
Range(rngAddress, rngAddress.End(xlDown)).Select
'MsgBox rngAddress.Address
Loop While rngAddress.Address <> firstAddress
End With
End Sub
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.