| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Looping through Range...Slow
Hi there.... I know that looping through a range is not the fastest way to
do it. But looking at different examples I can't quite figure out how to do it in my sistuation. Currently I am looping through a range(C1:C100), if the value is 1 then corrisponding row in Range(A1:A100) the text is changed to RED, if the value is 2 then corrisponding row in Range(A1:A100) the text is changed to Blue, if the value is 3 then corrisponding row in Range(A1:A100) the text is changed to Black and Bold, if the value is 4 then nothing. I have this working in a Userform under a spreadsheet control. It works fine except it runs very slow. I've tried adding Application.ScreenUpdating=False... which didn't help Is there a better way to run this? Thanks Craig |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Looping through Range...Slow
shouldn't be slow looping a hundred cells, can you post the relevant code?
-- Gary "Craig M" wrote in message news:dPNLg.512696$Mn5.417393@pd7tw3no... Hi there.... I know that looping through a range is not the fastest way to do it. But looking at different examples I can't quite figure out how to do it in my sistuation. Currently I am looping through a range(C1:C100), if the value is 1 then corrisponding row in Range(A1:A100) the text is changed to RED, if the value is 2 then corrisponding row in Range(A1:A100) the text is changed to Blue, if the value is 3 then corrisponding row in Range(A1:A100) the text is changed to Black and Bold, if the value is 4 then nothing. I have this working in a Userform under a spreadsheet control. It works fine except it runs very slow. I've tried adding Application.ScreenUpdating=False... which didn't help Is there a better way to run this? Thanks Craig |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Looping through Range...Slow
Looping through only a hundred cells should go pretty quickly, but if
your actual dataset is much larger than your example, using filters will make a noticeable difference. Try something like this... Sub color() With Cells(1, 1) .AutoFilter 'turns on filter .AutoFilter Field:=3, Criteria1:=1 .CurrentRegion.Offset(1, 0).Columns(1).SpecialCells _ (xlCellTypeVisible).Font.ColorIndex = 3 'red .AutoFilter Field:=3, Criteria1:=2 .CurrentRegion.Offset(1, 0).Columns(1).SpecialCells _ (xlCellTypeVisible).Font.ColorIndex = 5 'blue .AutoFilter Field:=3, Criteria1:=3 .CurrentRegion.Offset(1, 0).Columns(1).SpecialCells _ (xlCellTypeVisible).Font.Bold = True 'bold, I assumed the text was already black .AutoFilter 'turns off filter End With End Sub |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Looping through Range...Slow
I guess there is more happening here.... I was just wondering if I can make
it run a little faster! On a slower machine.... Private Sub OptionButton1_Change() Dim ssConstants If OptionButton1.Value = True Then Sheet1.Range("P1").Value = 5 Spreadsheet1.ActiveSheet.Unprotect Call border_reset Set ssConstants = Spreadsheet1.Constants Spreadsheet1.Worksheets("Sheet1").Range("B2:B4").B orderAround , ssConstants.xlMedium, 3 Spreadsheet1.Worksheets("Sheet1").Range("B6:B44"). BorderAround , ssConstants.xlMedium, 3 Spreadsheet1.Worksheets("Sheet1").Range("B46:B47") .BorderAround , ssConstants.xlMedium, 3 Spreadsheet1.Worksheets("Sheet1").Range("B49").Bor derAround , ssConstants.xlMedium, 3 Call diff_reset Call Chk_Concern Spreadsheet1.ActiveSheet.Protect End If End Sub Public Sub border_reset() Dim ssConstants Set ssConstants = Spreadsheet1.Constants Spreadsheet1.Worksheets("Sheet1").Range("D2:D4").B orderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("F2:F4").B orderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("H2:H4").B orderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("J2:J4").B orderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("B2:B4").B orderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("D6:D44"). BorderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("F6:F44"). BorderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("H6:H44"). BorderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("J6:J44"). BorderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("B6:B44"). BorderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("D46:D47") .BorderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("F46:F47") .BorderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("H46:H47") .BorderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("J46:J47") .BorderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("B46:B47") .BorderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("D49").Bor derAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("F49").Bor derAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("H49").Bor derAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("J49").Bor derAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("B49").Bor derAround , ssConstants.xlHairline, 1 End Sub Public Sub diff_reset() For i = 6 To 49 Spreadsheet1.Cells(i, 16).Value = Sheet1.Cells(i, 16).Value If Spreadsheet1.Cells(i, 16).Value < 0 Then Spreadsheet1.Cells(i, 16).Font.Color = vbRed Spreadsheet1.Cells(i, 16).Font.Bold = True ElseIf Spreadsheet1.Cells(i, 16).Value 0 Then Spreadsheet1.Cells(i, 16).Font.Color = vbBlue Spreadsheet1.Cells(i, 16).Font.Bold = True Else Spreadsheet1.Cells(i, 16).Font.Color = vbBlack End If Next i End Sub Public Sub Chk_Concern() For rRow = 6 To 47 If Spreadsheet1.Cells(rRow, 21).Value = 0 Then Spreadsheet1.Cells(rRow, 14).Font.Color = vbBlack Spreadsheet1.Cells(rRow, 14).Font.Bold = True ElseIf Spreadsheet1.Cells(rRow, 21).Value = 1 Then Spreadsheet1.Cells(rRow, 14).Font.Color = vbBlue Spreadsheet1.Cells(rRow, 14).Font.Bold = True ElseIf Spreadsheet1.Cells(rRow, 21).Value = 2 Then Spreadsheet1.Cells(rRow, 14).Font.Color = vbRed Spreadsheet1.Cells(rRow, 14).Font.Bold = True ElseIf Spreadsheet1.Cells(rRow, 21).Value = 3 Then Spreadsheet1.Cells(rRow, 14).Font.Color = vbBlack Spreadsheet1.Cells(rRow, 14).Font.Bold = False Else Spreadsheet1.Cells(rRow, 14).Font.Color = vbBlack Spreadsheet1.Cells(rRow, 14).Font.Bold = False End If Next rRow End Sub "Gary Keramidas" <GKeramidasATmsn.com wrote in message ... shouldn't be slow looping a hundred cells, can you post the relevant code? -- Gary "Craig M" wrote in message news:dPNLg.512696$Mn5.417393@pd7tw3no... Hi there.... I know that looping through a range is not the fastest way to do it. But looking at different examples I can't quite figure out how to do it in my sistuation. Currently I am looping through a range(C1:C100), if the value is 1 then corrisponding row in Range(A1:A100) the text is changed to RED, if the value is 2 then corrisponding row in Range(A1:A100) the text is changed to Blue, if the value is 3 then corrisponding row in Range(A1:A100) the text is changed to Black and Bold, if the value is 4 then nothing. I have this working in a Userform under a spreadsheet control. It works fine except it runs very slow. I've tried adding Application.ScreenUpdating=False... which didn't help Is there a better way to run this? Thanks Craig |
|
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Looping through Range...Slow
would something like this work, i just adapted the last part of it so you
could try it. Sub test2() For Each cell In Range("U6:U47") Select Case cell.Value Case Is = 0 cell.Offset(0, -7).Font.Color = vbBlack cell.Offset(0, -7).Font.Bold = True Case Is = 1 cell.Offset(0, -7).Font.Color = vbBlue cell.Offset(0, -7).Font.Bold = True Case Is = 2 cell.Offset(0, -7).Font.Color = vbRed cell.Offset(0, -7).Font.Bold = True Case Is = 3 cell.Offset(0, -7).Font.Color = vbBlack cell.Offset(0, -7).Font.Bold = False Case Else cell.Offset(0, -7).Font.Color = vbBlack cell.Offset(0, -7).Font.Bold = False End Select Next End Sub -- Gary "Craig M" wrote in message news:NpOLg.512869$Mn5.167766@pd7tw3no... I guess there is more happening here.... I was just wondering if I can make it run a little faster! On a slower machine.... Private Sub OptionButton1_Change() Dim ssConstants If OptionButton1.Value = True Then Sheet1.Range("P1").Value = 5 Spreadsheet1.ActiveSheet.Unprotect Call border_reset Set ssConstants = Spreadsheet1.Constants Spreadsheet1.Worksheets("Sheet1").Range("B2:B4").B orderAround , ssConstants.xlMedium, 3 Spreadsheet1.Worksheets("Sheet1").Range("B6:B44"). BorderAround , ssConstants.xlMedium, 3 Spreadsheet1.Worksheets("Sheet1").Range("B46:B47") .BorderAround , ssConstants.xlMedium, 3 Spreadsheet1.Worksheets("Sheet1").Range("B49").Bor derAround , ssConstants.xlMedium, 3 Call diff_reset Call Chk_Concern Spreadsheet1.ActiveSheet.Protect End If End Sub Public Sub border_reset() Dim ssConstants Set ssConstants = Spreadsheet1.Constants Spreadsheet1.Worksheets("Sheet1").Range("D2:D4").B orderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("F2:F4").B orderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("H2:H4").B orderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("J2:J4").B orderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("B2:B4").B orderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("D6:D44"). BorderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("F6:F44"). BorderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("H6:H44"). BorderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("J6:J44"). BorderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("B6:B44"). BorderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("D46:D47") .BorderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("F46:F47") .BorderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("H46:H47") .BorderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("J46:J47") .BorderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("B46:B47") .BorderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("D49").Bor derAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("F49").Bor derAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("H49").Bor derAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("J49").Bor derAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("B49").Bor derAround , ssConstants.xlHairline, 1 End Sub Public Sub diff_reset() For i = 6 To 49 Spreadsheet1.Cells(i, 16).Value = Sheet1.Cells(i, 16).Value If Spreadsheet1.Cells(i, 16).Value < 0 Then Spreadsheet1.Cells(i, 16).Font.Color = vbRed Spreadsheet1.Cells(i, 16).Font.Bold = True ElseIf Spreadsheet1.Cells(i, 16).Value 0 Then Spreadsheet1.Cells(i, 16).Font.Color = vbBlue Spreadsheet1.Cells(i, 16).Font.Bold = True Else Spreadsheet1.Cells(i, 16).Font.Color = vbBlack End If Next i End Sub Public Sub Chk_Concern() For rRow = 6 To 47 If Spreadsheet1.Cells(rRow, 21).Value = 0 Then Spreadsheet1.Cells(rRow, 14).Font.Color = vbBlack Spreadsheet1.Cells(rRow, 14).Font.Bold = True ElseIf Spreadsheet1.Cells(rRow, 21).Value = 1 Then Spreadsheet1.Cells(rRow, 14).Font.Color = vbBlue Spreadsheet1.Cells(rRow, 14).Font.Bold = True ElseIf Spreadsheet1.Cells(rRow, 21).Value = 2 Then Spreadsheet1.Cells(rRow, 14).Font.Color = vbRed Spreadsheet1.Cells(rRow, 14).Font.Bold = True ElseIf Spreadsheet1.Cells(rRow, 21).Value = 3 Then Spreadsheet1.Cells(rRow, 14).Font.Color = vbBlack Spreadsheet1.Cells(rRow, 14).Font.Bold = False Else Spreadsheet1.Cells(rRow, 14).Font.Color = vbBlack Spreadsheet1.Cells(rRow, 14).Font.Bold = False End If Next rRow End Sub "Gary Keramidas" <GKeramidasATmsn.com wrote in message ... shouldn't be slow looping a hundred cells, can you post the relevant code? -- Gary "Craig M" wrote in message news:dPNLg.512696$Mn5.417393@pd7tw3no... Hi there.... I know that looping through a range is not the fastest way to do it. But looking at different examples I can't quite figure out how to do it in my sistuation. Currently I am looping through a range(C1:C100), if the value is 1 then corrisponding row in Range(A1:A100) the text is changed to RED, if the value is 2 then corrisponding row in Range(A1:A100) the text is changed to Blue, if the value is 3 then corrisponding row in Range(A1:A100) the text is changed to Black and Bold, if the value is 4 then nothing. I have this working in a Userform under a spreadsheet control. It works fine except it runs very slow. I've tried adding Application.ScreenUpdating=False... which didn't help Is there a better way to run this? Thanks Craig |
|
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Looping through Range...Slow
You can work on multiple ranges simultaneously and also cut down on the
number of objects (the number of "."s ) that has to resolved each time, either by using the "With" keyword" of setting an object variable to the object(s) that you are manipulating For example: Dim WorkRange As Range If OptionButton1.Value Then Sheet1.Range("P1").Value = 5 With Spreadsheet1 .ActiveSheet.Unprotect Call border_reset Set ssConstants = .Constants With .Worksheets("Sheet1") Set WorkRange = Union(.Range("B2:B4"), .Range("B6:B44"), ..Range("B46:B47"), .Range("B49")) End With WorkRange.BorderAround , ssConstants.xlMedium, 3 Call diff_reset Call Chk_Concern .ActiveSheet.Protect End With End If Your other routuines would also benefit from these chnages. NickHK "Craig M" wrote in message news:NpOLg.512869$Mn5.167766@pd7tw3no... I guess there is more happening here.... I was just wondering if I can make it run a little faster! On a slower machine.... Private Sub OptionButton1_Change() Dim ssConstants If OptionButton1.Value = True Then Sheet1.Range("P1").Value = 5 Spreadsheet1.ActiveSheet.Unprotect Call border_reset Set ssConstants = Spreadsheet1.Constants Spreadsheet1.Worksheets("Sheet1").Range("B2:B4").B orderAround , ssConstants.xlMedium, 3 Spreadsheet1.Worksheets("Sheet1").Range("B6:B44"). BorderAround , ssConstants.xlMedium, 3 Spreadsheet1.Worksheets("Sheet1").Range("B46:B47") .BorderAround , ssConstants.xlMedium, 3 Spreadsheet1.Worksheets("Sheet1").Range("B49").Bor derAround , ssConstants.xlMedium, 3 Call diff_reset Call Chk_Concern Spreadsheet1.ActiveSheet.Protect End If End Sub Public Sub border_reset() Dim ssConstants Set ssConstants = Spreadsheet1.Constants Spreadsheet1.Worksheets("Sheet1").Range("D2:D4").B orderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("F2:F4").B orderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("H2:H4").B orderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("J2:J4").B orderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("B2:B4").B orderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("D6:D44"). BorderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("F6:F44"). BorderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("H6:H44"). BorderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("J6:J44"). BorderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("B6:B44"). BorderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("D46:D47") .BorderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("F46:F47") .BorderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("H46:H47") .BorderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("J46:J47") .BorderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("B46:B47") .BorderAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("D49").Bor derAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("F49").Bor derAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("H49").Bor derAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("J49").Bor derAround , ssConstants.xlHairline, 1 Spreadsheet1.Worksheets("Sheet1").Range("B49").Bor derAround , ssConstants.xlHairline, 1 End Sub Public Sub diff_reset() For i = 6 To 49 Spreadsheet1.Cells(i, 16).Value = Sheet1.Cells(i, 16).Value If Spreadsheet1.Cells(i, 16).Value < 0 Then Spreadsheet1.Cells(i, 16).Font.Color = vbRed Spreadsheet1.Cells(i, 16).Font.Bold = True ElseIf Spreadsheet1.Cells(i, 16).Value 0 Then Spreadsheet1.Cells(i, 16).Font.Color = vbBlue Spreadsheet1.Cells(i, 16).Font.Bold = True Else Spreadsheet1.Cells(i, 16).Font.Color = vbBlack End If Next i End Sub Public Sub Chk_Concern() For rRow = 6 To 47 If Spreadsheet1.Cells(rRow, 21).Value = 0 Then Spreadsheet1.Cells(rRow, 14).Font.Color = vbBlack Spreadsheet1.Cells(rRow, 14).Font.Bold = True ElseIf Spreadsheet1.Cells(rRow, 21).Value = 1 Then Spreadsheet1.Cells(rRow, 14).Font.Color = vbBlue Spreadsheet1.Cells(rRow, 14).Font.Bold = True ElseIf Spreadsheet1.Cells(rRow, 21).Value = 2 Then Spreadsheet1.Cells(rRow, 14).Font.Color = vbRed Spreadsheet1.Cells(rRow, 14).Font.Bold = True ElseIf Spreadsheet1.Cells(rRow, 21).Value = 3 Then Spreadsheet1.Cells(rRow, 14).Font.Color = vbBlack Spreadsheet1.Cells(rRow, 14).Font.Bold = False Else Spreadsheet1.Cells(rRow, 14).Font.Color = vbBlack Spreadsheet1.Cells(rRow, 14).Font.Bold = False End If Next rRow End Sub "Gary Keramidas" <GKeramidasATmsn.com wrote in message ... shouldn't be slow looping a hundred cells, can you post the relevant code? -- Gary "Craig M" wrote in message news:dPNLg.512696$Mn5.417393@pd7tw3no... Hi there.... I know that looping through a range is not the fastest way to do it. But looking at different examples I can't quite figure out how to do it in my sistuation. Currently I am looping through a range(C1:C100), if the value is 1 then corrisponding row in Range(A1:A100) the text is changed to RED, if the value is 2 then corrisponding row in Range(A1:A100) the text is changed to Blue, if the value is 3 then corrisponding row in Range(A1:A100) the text is changed to Black and Bold, if the value is 4 then nothing. I have this working in a Userform under a spreadsheet control. It works fine except it runs very slow. I've tried adding Application.ScreenUpdating=False... which didn't help Is there a better way to run this? Thanks Craig |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Determine if range has NO Blank Cells without looping through each cell in range | Excel Programming | |||
| Looping in a range | Excel Programming | |||
| Slow Looping | Excel Programming | |||
| Slow Looping | Excel Programming | |||
| looping through a range | Excel Programming | |||
Linear Mode
