![]() |
Loop through found value
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: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 |
Loop through found value
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: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 -- Regards, Tom Ogilvy "GregR" wrote: 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: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 |
Loop through found value
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: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:D").FindNext(rng) Loop Until rng.Address = strFirstAddress End If End Sub -- HTH... Jim Thomlinson "GregR" wrote: 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: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 |
Loop through found value
On Mar 2, 9:30 am, Jim Thomlinson <James_Thomlin...@owfg-Re-Move-
This-.com wrote: 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: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:D").FindNext(rng) Loop Until rng.Address = strFirstAddress End If End Sub -- HTH... Jim Thomlinson "GregR" wrote: 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: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- Hide quoted text - - Show quoted text - Tom, Jim and Don thank you very much for your help. Greg |
All times are GMT +1. The time now is 03:39 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com