For.... Next Loop? Best way forward?

smar2832

New Member
Joined
Oct 13, 2011
Messages
17
Hi VBAers,

As I delve deeper into excel I am learning many more exciting functions but am also coming up against many more problems!


Is there a way to use a "for...next" loop in order to copy the below code 300 times? i.e. I have 300 different text boxes that are conditionally formatted individually based on 300 different cells. If i have a list of the textboxes and a list of the cells could i use a loop to make this happen? or am i best to copy the code 300 times and manually update it?

Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Sheets("Aust Fixed").Range("B272") > 0 Then
Sheets("Australia").Shapes("TextBox 406").Select
With Selection.Font
.Color = RGB(0, 0, 0)
End With

ElseIf Sheets("Aust Fixed").Range("B272") < 0 Then

Sheets("Australia").Shapes("TextBox 406").Select

With Selection.Font
.Color = RGB(255, 0, 0)
End With

End If

End Sub

Any help would be much appreciated!
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
One could do looping for that.

If I had over 300 arbitrary correspondences between textboxes, cells and colors, I would redesign the project so that the correspondences were logical, so that given the cell, I could deduce the number of the textbox and the color.

If that were not possible, a lookup chart would be the easiest way to maintain things.
 
Upvote 0
So if I was to do a loop, what would the code look like?

I have a list of the textbox numbers and the cells that effect it. how would i go about calling these in the loop??

Obviously I have not done one before :eeek:
 
Upvote 0
The posted code could be written

Code:
With Range("'Aust Fixed'!B272")
    Sheets("Australia").Shapes("TextBox 406").Font.Color = RGB(IIf(.Value < 0, 255, 0), 0, 0)
End With


One could loop around that.
If the list of Range addresses is in Sheet1!A1:A10, with cell contents like the text 'Aust Fixed'!B272
TextBoxes in Sheet1!B1:B10, contents like TextBox406 .

This would do it.
Code:
Dim oneAddresses as Range

For Each oneAddress in Worksheets("Sheet1").Range("A1:A10").Cells
    With Range(oneAddress.Value)
        Sheets("Australia").TextBox(oneAddress.Offset(0,1).Value).Font.Color = RGB(IIf(.Value < 0, 255, 0), 0, 0)
    End With
Next oneAddress
 
Upvote 0
I tried the following and got an error: "Run-time error '1004': Method 'Range' of object'_Worksheet'failed"

I think it may be because the value in the textbox is actually linked to a cell rather than typed in?? Sorry i forgot to mention that. e.g. in the case below "textbox 664" is actually linked to "Aust Fixed'!B259". Could this be causing the error?

Thanks so much


Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

With Range("'Aust Fixed'!B259")
    Sheets("Australia").Shapes("TextBox 664").Font.Color = RGB(IIf(.Value < 0,255, 0), 0, 0)
End With

End Sub
 
Upvote 0
I tried the following and got an error: "Run-time error '1004': Method 'Range' of object'_Worksheet'failed"
Code:
With Range("'Aust Fixed'!B259")
I'm about to go to bed, but I looked quickly at this thread, so I'm not totally into it; but I would think the above quoted line should be written this way (if it helps any)...

Code:
With Sheets("Aust Fixed").Range("B259")
 
Upvote 0
hmmm.... as advised I have implemented the code to read:

Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

With Sheets("Aust Fixed").Range("B259")
    Sheets("Australia").Shapes("TextBox 664").Font.Color = RGB(IIf(.Value < 0, 255, 0), 0, 0)
End With

End Sub

I now get error message: "Run-time error '438': Object doesn't support this property or method"

I really like this more condensed form of code. I hope it can work. Thoughts?
 
Upvote 0
Oops, I didn't check the OP code.
A Shape object doesn't have a Font property.
To change the color of the the text in a shape, one must change

ActiveSheet.Shapes("some Shape").TextFrame.Characters.Font.Color
 
Upvote 0
Thanks! Works like a treat.

Now to get it working in a loop....

I have tried to adapt the loop to include the amended code but it does not seem to like what i have done:

Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim oneAddresses As Range
For Each oneAddress In Worksheets("VBA").Range("B2:B300").Cells
    With Range(oneAddress.Value)
        ActiveSheet.Shapes(oneAddress.Offset(0, 1).Value).TextFrame.Characters.Font.Color = RGB(IIf(.Value < 0, 255, 0), 0, 0)
    End With
Next oneAddress

End Sub

Like you suggested I have put the cell references in the first column and the textboxes in the second colume. B being the first column and C being the second.

I am currently using the format "TextBox 1". (With the inverted commas, also tried without)

I get the following error: "Run-time error '-2147024809 (80070057)': the item wiht the specified name wasn't found."

Any ideas? I feel it is so close.
 
Upvote 0

Forum statistics

Threads
1,224,249
Messages
6,177,417
Members
452,774
Latest member
Macca1962

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top