Loop through found value

[GregR]

I have this code that I want to loop through and format each found
value, not just the firtst one, How?

Sub ByPerson()
'
Selection.QueryTable.Refresh BackgroundQuery:=False
Selection.Sort Key1:=Range("D2"), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Selection.Subtotal GroupBy:=4, Function:=xlSum,
TotalList:=Array(9, 22), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
ActiveSheet.Outline.ShowLevels RowLevels:=2

Set Rng = ActiveSheet.Range("D").Find(What:="Total", _
After:=Range("D"
& Rows.Count), _

LookIn:=xlFormulas, _
LookAt:=xlPart, _

SearchOrder:=xlByRows, _

SearchDirection:=xlNext, _
MatchCase:=False)
Rng.NumberFormat = "General"
End Sub

TIA Greg

 

[Don Guillett]

Look in the help index for findNEXT. There should be a good example there.

 

[Guest]

Sub ByPerson()
'
Dim rng as Range, sAddr as String
Selection.QueryTable.Refresh BackgroundQuery:=False
Selection.Sort Key1:=Range("D2"), _
Order1:=xlAscending, _
Header:=xlGuess, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom
Selection.Subtotal GroupBy:=4, _
Function:=xlSum,
TotalList:=Array(9, 22), _
Replace:=True, _
PageBreaks:=False, _
SummaryBelowData:=True
ActiveSheet.Outline.ShowLevels RowLevels:=2
With ActiveSheet.Range("D")
Set Rng = .Find(What:="Total", _
After:=Range("D" & Rows.Count), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
if not rng is nothing then
sAddr = rng.Address
do
Rng.NumberFormat = "General"
set rng = .FindNext(rng)
loop while rng.Address <> sAddr
End With
End Sub

I am not sure you are formatting the correct cell. the cells you find
contain the word total indicating they contain text. Perhaps you want
something like

rng.Offset(0,1).NumberFormat = "General"
to format column E entries (as an example)
Just a thought

 

[Guest]

This should do it for you. ( you sould probably change the Header:=xlGuess to
xlYes or xlNo)...

Sub ByPerson()
Dim rng As Range
Dim strFirstAddress As String

With Selection
.QueryTable.Refresh BackgroundQuery:=False
.Sort Key1:=Range("D2"), _
Order1:=xlAscending, _
Header:=xlGuess, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom
.Subtotal GroupBy:=4, _
Function:=xlSum, _
TotalList:=Array(9, 22), _
Replace:=True, _
PageBreaks:=False, _
SummaryBelowData:=True
End With
ActiveSheet.Outline.ShowLevels RowLevels:=2

Set rng = ActiveSheet.Range("D").Find(What:="Total", _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
MatchCase:=False)

If Not rng Is Nothing Then
strFirstAddress = rng.Address
Do
rng.NumberFormat = "General"
Set rng = ActiveSheet.Range("D").FindNext(rng)
Loop Until rng.Address = strFirstAddress
End If
End Sub

 

[GregR]

This should do it for you. ( you sould probably change the Header:=xlGuess to
xlYes or xlNo)...

Sub ByPerson()
Dim rng As Range
Dim strFirstAddress As String

With Selection
.QueryTable.Refresh BackgroundQuery:=False
.Sort Key1:=Range("D2"), _
Order1:=xlAscending, _
Header:=xlGuess, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom
.Subtotal GroupBy:=4, _
Function:=xlSum, _
TotalList:=Array(9, 22), _
Replace:=True, _
PageBreaks:=False, _
SummaryBelowData:=True
End With
ActiveSheet.Outline.ShowLevels RowLevels:=2

Set rng = ActiveSheet.Range("D").Find(What:="Total", _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
MatchCase:=False)

If Not rng Is Nothing Then
strFirstAddress = rng.Address
Do
rng.NumberFormat = "General"
Set rng = ActiveSheet.Range("D").FindNext(rng)
Loop Until rng.Address = strFirstAddress
End If
End Sub
--
HTH...

Jim Thomlinson











- Show quoted text -

Tom, Jim and Don thank you very much for your help.

Greg