PDA

View Full Version : For Each.. loop decisions



alienscript
07-01-2008, 12:56 AM
Hello VB expert,

I need some help please. I want to run thru each sh except Sheets("summary"), and in the InputBox I would type column "H". For every Cells(i, action).Value = "Accuracy" and then if the values in Cells(i, intCol) besides the cells "Accuracy" are having these criteria:

< -10% :then fill Interior.ColorIndex = 3 in Cells(i, intCol)
> +10% :then fill Interior.ColorIndex = 6 in Cells(i, intCol)
between -10% to 10% :then fill Interior.ColorIndex = 4 in Cells(i, intCol)

My syntax doesnt work. Could someone help me to amend this please. Many many thanks.





Option Explicit

Sub CellsColorFill()
Dim intCol As Integer, strCol As String, intColsInSheet As Integer, lastrow As Long
Dim action As Integer, measure As Single, accuracy As String, sh As Worksheet, i As Long
Sheets(3).Activate
Get_Column:
strCol = InputBox("type in the column or cell of the month that you want to measure and click OK")
If strCol = "" Then
MsgBox "Cancelled by User"
GoTo Bye
End If

intCol = Columns(strCol).Column ' convert column entered to integer
intColsInSheet = Cells(4, 256).End(xlToLeft).Column ' Get columns in the sheet

If intCol > intColsInSheet Then
MsgBox "you entered an invalid column. Please try again"
GoTo Get_Column
End If
For Each sh In Worksheets
If sh.Name Like "FEP*" = True And sh.Name Like "CMP" = True And sh.Name Like "*CVD" = True And sh.Name Like "*PVD" = True Then
lastrow = Sheets("CMP").Range("G65536").End(xlUp).Row
For i = 5 To lastrow
Rows("4:4").Cells.Find(What:="Action", After:=[A4]).Select
action = ActiveCell.Column
accuracy = Cells(i, action).Value
measure = Cells(i, intCol).Value

On Error Resume Next
If accuracy = "Accuracy" And measure <> vbNullString Then
Cells(i, intCol).Select
With Selection.Interior
If measure < -0.1 Then
.ColorIndex = 3
ElseIf measure > 0.1 Then
.ColorIndex = 6
ElseIf measure >= -0.1 And measure <= 0.1 Then
.ColorIndex = 4
End If
End With
End If
Next i
End If
Next sh
Bye: Exit Sub
End Sub

Bob Phillips
07-01-2008, 01:10 AM
Not hundred percent sure as you don't detail the problem, but does this do it



Option Explicit

Sub CellsColorFill()
Dim intCol As Integer, strCol As String, intColsInSheet As Integer, lastrow As Long
Dim action As Integer, measure As Single, accuracy As String, sh As Worksheet, i As Long
Dim cell As Range

With Sheets("FEP(DIFFUSION)")

Get_Column:
strCol = InputBox("type in the column or cell of the month that you want to measure and click OK")
If strCol = "" Then
MsgBox "Cancelled by User"
GoTo Bye
End If

intCol = .Columns(strCol).Column ' convert column entered to integer
intColsInSheet = .Cells(4, .Columns.Count).End(xlToLeft).Column ' Get columns in the sheet

If intCol > intColsInSheet Then
MsgBox "you entered an invalid column. Please try again"
GoTo Get_Column
End If
End With

For Each sh In Worksheets

If sh.Name Like "FEP*" Or sh.Name Like "CMP" Or _
sh.Name Like "*CVD" Or sh.Name Like "*PVD" Then

With sh

lastrow = .Range("G" & .Rows.Count).End(xlUp).Row
For i = 5 To lastrow

Set cell = Nothing
Set cell = .Rows("4:4").Cells.Find(What:="Action", After:=.Range("A4"))
action = cell.Column
accuracy = .Cells(i, action).Value
measure = .Cells(i, intCol).Value

On Error Resume Next
If accuracy = "Accuracy" And measure <> vbNullString Then

With .Cells(i, intCol).Interior

Select Case measure

Case Is < -0.1: .ColorIndex = 3
Case Is > 0.1: .ColorIndex = 6
Case Else: .ColorIndex = 4
End With
End If
Next i
End With
End If
Next sh
Bye:
Exit Sub
End Sub


Should yo

alienscript
07-01-2008, 01:48 AM
Hello Xld,

it filled out all the cells in the range in column H which is not what I want. I only want the cells in column H (assuming I type H in InputBox) to be filled with the specified colors when column G has the cell value "Accuracy".

I attach the sample of what it should looks like. Please help advise again. and Thanks.

alienscript
07-01-2008, 09:43 AM
Hello all people,

I tried to edit the code helped out from Xld, now the sheet "FEP(GVD)" had the correct cells in column H filled with the correct colors, but the rest of the sheets are not. I cracked my head the whole evening and just couldnt work out what went wrong with the For Each..Next loop. I hope able to get some help again from the nice people out here.

Thanks a lot.




Option Explicit

Sub CellsColorFill()
Dim intCol As Integer, strCol As String, intColsInSheet As Integer, lastrow As Long
Dim actionCol As Integer, colOffset As Byte, measure As Double, accuracy As String, sh As Worksheet, i As Long
Dim cell As Range, a1 As String, a2 As String

With Sheets(3)
Get_Column:
strCol = InputBox("type in the column or cell of the month that you want to measure and click OK")
If strCol = "" Then
MsgBox "Cancelled by User"
GoTo Bye
End If

intCol = .Columns(strCol).Column
intColsInSheet = .Cells(4, .Columns.Count).End(xlToLeft).Column

If intCol > intColsInSheet Then
MsgBox "you entered an invalid column. Please try again"
GoTo Get_Column
End If
End With

For Each sh In Worksheets
If sh.Name Like "FEP*" Or sh.Name Like "CMP" Or sh.Name Like "*CVD*" _
Or sh.Name Like "*PVD*" Then
With sh
lastrow = .Range("G" & .Rows.Count).End(xlUp).Row
Set cell = Nothing
Set cell = .Rows("4:4").Cells.Find(What:="Action", After:=.Range("A4"))
actionCol = cell.Column
colOffset = intCol - actionCol
a1 = Sheets("FEP(GVD)").Range("A1").Value
a2 = Sheets("FEP(GVD)").Range("A2").Value

For i = 5 To lastrow
accuracy = .Cells(i, actionCol).Value
measure = Cells(i, actionCol).Offset(, colOffset).Value

On Error Resume Next
If accuracy = "Accuracy" Then
If measure <> vbNullString Then
With .Cells(i, intCol).Interior
Select Case measure
Case Is < a2
.ColorIndex = 3
Case Is > a1
.ColorIndex = 6
Case Else:
.ColorIndex = 4
End Select
End With
End If
End If
Next i
End With
End If
Next sh
Bye: Exit Sub
End Sub