Why does code keep going to function?

  • Thread starter Thread starter ChipButtyMan
  • Start date Start date
C

ChipButtyMan

Hi,
I have a worksheet with five CommandButtons.
The second Command button uses a function in Module1
The third button (or any of the other buttons) does not use the
function.
Why then does when clicking the third button when it gets to the first
line of code after the dims it goes to the function? This line of code
is;

Range("F1").Value = "Computing" & Chr(10) & "please" & Chr(10) &
"wait"

The reason that this is the line of code is because this function
short circuit is costing time & I need to advise the user.
Please help it is driving me insane!

Thanks everyone
 
I think it would help if we could see the code for the 3rd CommandButton's
events. Also, what is the function's name.
 
Hi Rick,
the function is called FuzzyMatch.
The (pretty amateur & no doubt laughable) code for my third button is
as follows. I won't blame you if you lose interest in this :-) Thanks
for your help.

Private Sub CommandButton3_Click()
Dim i As Long
Dim r As Long
Dim MyRangeB As Range, MyRangeG As Range, b As Range, G As Range
Dim LastRowB As Long, LastrowG As Long

'On debug, leaving the following row goes to FuzzyMatch!
Range("F1").Value = "Computing" &
Chr(10) & "please" & Chr(10) & "wait"
Range("F1").Font.ColorIndex = 2
If Range("E1").Interior.ColorIndex = 15 Then
MsgBox "You did not paste formula yet"
GoTo TheTerminator1
Else: GoTo TheTerminator2
End If
TheTerminator2:
r = Range("B" & Rows.Count).End(xlUp).Row
Range("B2:B" & r).Select
Selection.Copy
Range("F2").Select
ActiveSheet.Paste
Application.CutCopyMode = False

Range("F2:F" & r).Select
Selection.Sort Key1:=Range("F2"), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Range("F1").Select
Range("F1").Value = "Computing" & Chr(10) & "please" & Chr(10) &
"wait"

r = Range("F" & Rows.Count).End(xlUp).Row
Range("F1:F" & r).AdvancedFilter Action:=xlFilterCopy,
CopyToRange:=Range( _
"G1"), Unique:=True


r = Range("G" & Rows.Count).End(xlUp).Row
For i = 2 To r
If Range("G" & i) <> "" Then
Range("H" & i).Value = i - 1
Else: GoTo Terminus
End If
Next
Terminus:

LastRowB = Cells(Rows.Count, "B").End(xlUp).Row
LastrowG = Cells(Rows.Count, "G").End(xlUp).Row
Set MyRangeG = Range("G2:G" & LastrowG)
Set MyRangeB = Range("B2:B" & LastRowB)
For Each b In MyRangeB
For Each G In MyRangeG
If b.Value = G.Value Then
b.Offset(, 1).Value = G.Offset(, 1).Value
End If

Next
Next

r = Range("C" & Rows.Count).End(xlUp).Row
Range("C2" & ":" & "C" & r).Interior.ColorIndex = 15



For i = 2 To r
With Range("C" & i).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("C" & i).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("C" & i).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("C" & i).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With

Next i

r = Range("F" & Rows.Count).End(xlUp).Row
Range("F2" & ":" & "F" & r).Interior.ColorIndex = 15
For i = 2 To r
With Range("F" & i).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("F" & i).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("F" & i).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("F" & i).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With

Next i


r = Range("G" & Rows.Count).End(xlUp).Row
Range("G2" & ":" & "G" & r).Interior.ColorIndex = 15
For i = 2 To r
With Range("G" & i).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("G" & i).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("G" & i).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("G" & i).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With

Next i


r = Range("H" & Rows.Count).End(xlUp).Row
Range("H2" & ":" & "H" & r).Interior.ColorIndex = 15

For i = 2 To r
With Range("H" & i).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("H" & i).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("H" & i).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("H" & i).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With

Next i
Range("F1").ClearContents
Range("F1").Font.ColorIndex = 5
Range("F1").Value = "Button" & Chr(10) & "Cleared"
Range("F1").Interior.ColorIndex = 48
Range("G1").Select
Range("G1").Interior.ColorIndex = 15
Range("G1").Font.ColorIndex = 2
Range("G1").Value = "Click" & Chr(10) & "this"


TheTerminator1:
End Sub
 
Hi Rick,

Function is called FuzzyMatch

Code for button is;

Private Sub CommandButton3_Click()
Dim i As Long
Dim r As Long
Dim MyRangeB As Range, MyRangeG As Range, b As Range, G As Range
Dim LastRowB As Long, LastrowG As Long

'On leaving the next row goes to FuzzyMatch!

Range("F1").Value = "Computing" & Chr(10) & "please" & Chr(10) &
"wait"
Range("F1").Font.ColorIndex = 2
If Range("E1").Interior.ColorIndex = 15 Then
MsgBox "You did not paste formula yet"
GoTo TheTerminator1
Else: GoTo TheTerminator2
End If
TheTerminator2:
r = Range("B" & Rows.Count).End(xlUp).Row
Range("B2:B" & r).Select
Selection.Copy
Range("F2").Select
ActiveSheet.Paste
ActiveSheet.Paste
Application.CutCopyMode = False

Range("F2:F" & r).Select
Selection.Sort Key1:=Range("F2"), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Range("F1").Select
Range("F1").Value = "Computing" & Chr(10) & "please" & Chr(10) &
"wait"

r = Range("F" & Rows.Count).End(xlUp).Row
Range("F1:F" & r).AdvancedFilter Action:=xlFilterCopy,
CopyToRange:=Range( _
"G1"), Unique:=True


r = Range("G" & Rows.Count).End(xlUp).Row
For i = 2 To r
If Range("G" & i) <> "" Then
Range("H" & i).Value = i - 1
Else: GoTo Terminus
End If
Next
Terminus:

LastRowB = Cells(Rows.Count, "B").End(xlUp).Row
LastrowG = Cells(Rows.Count, "G").End(xlUp).Row
Set MyRangeG = Range("G2:G" & LastrowG)
Set MyRangeB = Range("B2:B" & LastRowB)
For Each b In MyRangeB
For Each G In MyRangeG
If b.Value = G.Value Then
b.Offset(, 1).Value = G.Offset(, 1).Value
End If

Next
Next

r = Range("C" & Rows.Count).End(xlUp).Row
Range("C2" & ":" & "C" & r).Interior.ColorIndex = 15
For i = 2 To r
With Range("C" & i).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("C" & i).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("C" & i).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("C" & i).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With

Next i

r = Range("F" & Rows.Count).End(xlUp).Row
Range("F2" & ":" & "F" & r).Interior.ColorIndex = 15
For i = 2 To r
With Range("F" & i).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("F" & i).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("F" & i).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("F" & i).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With

Next i


r = Range("G" & Rows.Count).End(xlUp).Row
Range("G2" & ":" & "G" & r).Interior.ColorIndex = 15
For i = 2 To r
With Range("G" & i).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("G" & i).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("G" & i).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("G" & i).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With

Next i


r = Range("H" & Rows.Count).End(xlUp).Row
Range("H2" & ":" & "H" & r).Interior.ColorIndex = 15

For i = 2 To r
With Range("H" & i).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("H" & i).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("H" & i).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("H" & i).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With

Next i
Range("F1").ClearContents
Range("F1").Font.ColorIndex = 5
Range("F1").Value = "Button" & Chr(10) & "Cleared"
Range("F1").Interior.ColorIndex = 48
Range("G1").Select
Range("G1").Interior.ColorIndex = 15
Range("G1").Font.ColorIndex = 2
Range("G1").Value = "Click" & Chr(10) & "this"


TheTerminator1:
End Sub
 
I think it would help if we could see the code for the 3rd CommandButton's
events. Also, what is the function's name.

--
Rick (MVP - Excel)









- Show quoted text -
Click to expand...

Hi Rick,
function name is FuzzyMatch and code for third button is;

Private Sub CommandButton3_Click()
Dim i As Long
Dim r As Long
Dim MyRangeB As Range, MyRangeG As Range, b As Range, G As Range
Dim LastRowB As Long, LastrowG As Long

'On leaving the next row goes to FuzzyMatch!

Range("F1").Value = "Computing" & Chr(10) & "please" & Chr(10) &
"wait"
Range("F1").Font.ColorIndex = 2
If Range("E1").Interior.ColorIndex = 15 Then
MsgBox "You did not paste formula yet"
GoTo TheTerminator1
Else: GoTo TheTerminator2
End If
TheTerminator2:
r = Range("B" & Rows.Count).End(xlUp).Row
Range("B2:B" & r).Select
Selection.Copy
Range("F2").Select
ActiveSheet.Paste
ActiveSheet.Paste
Application.CutCopyMode = False

Range("F2:F" & r).Select
Selection.Sort Key1:=Range("F2"), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Range("F1").Select
Range("F1").Value = "Computing" & Chr(10) & "please" & Chr(10) &
"wait"

r = Range("F" & Rows.Count).End(xlUp).Row
Range("F1:F" & r).AdvancedFilter Action:=xlFilterCopy,
CopyToRange:=Range( _
"G1"), Unique:=True


r = Range("G" & Rows.Count).End(xlUp).Row
For i = 2 To r
If Range("G" & i) <> "" Then
Range("H" & i).Value = i - 1
Else: GoTo Terminus
End If
Next
Terminus:

LastRowB = Cells(Rows.Count, "B").End(xlUp).Row
LastrowG = Cells(Rows.Count, "G").End(xlUp).Row
Set MyRangeG = Range("G2:G" & LastrowG)
Set MyRangeB = Range("B2:B" & LastRowB)
For Each b In MyRangeB
For Each G In MyRangeG
If b.Value = G.Value Then
b.Offset(, 1).Value = G.Offset(, 1).Value
End If

Next
Next

r = Range("C" & Rows.Count).End(xlUp).Row
Range("C2" & ":" & "C" & r).Interior.ColorIndex = 15
For i = 2 To r
With Range("C" & i).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("C" & i).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("C" & i).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("C" & i).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With

Next i

r = Range("F" & Rows.Count).End(xlUp).Row
Range("F2" & ":" & "F" & r).Interior.ColorIndex = 15
For i = 2 To r
With Range("F" & i).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("F" & i).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("F" & i).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("F" & i).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With

Next i


r = Range("G" & Rows.Count).End(xlUp).Row
Range("G2" & ":" & "G" & r).Interior.ColorIndex = 15
For i = 2 To r
With Range("G" & i).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("G" & i).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("G" & i).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("G" & i).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With

Next i


r = Range("H" & Rows.Count).End(xlUp).Row
Range("H2" & ":" & "H" & r).Interior.ColorIndex = 15

For i = 2 To r
With Range("H" & i).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("H" & i).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("H" & i).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("H" & i).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With

Next i
Range("F1").ClearContents
Range("F1").Font.ColorIndex = 5
Range("F1").Value = "Button" & Chr(10) & "Cleared"
Range("F1").Interior.ColorIndex = 48
Range("G1").Select
Range("G1").Interior.ColorIndex = 15
Range("G1").Font.ColorIndex = 2
Range("G1").Value = "Click" & Chr(10) & "this"


TheTerminator1:
End Sub
 
Hi,
    I have a worksheet with five CommandButtons.
The second Command button uses a function in Module1
The third button (or any of the other buttons) does not use the
function.
Why then does when clicking the third button when it gets to the first
line of code after the dims it goes to the function? This line of code
is;

Range("F1").Value = "Computing" & Chr(10) & "please" & Chr(10) &
"wait"

The reason that this is the line of code is because this function
short circuit is costing time & I need to advise the user.
Please help it is driving me insane!

Thanks everyone
Click to expand...

Hi Rick,
the function name is FuzzyMatch and the code for the third button is;

Private Sub CommandButton3_Click()
Dim i As Long
Dim r As Long
Dim MyRangeB As Range, MyRangeG As Range, b As Range, G As Range
Dim LastRowB As Long, LastrowG As Long

'On leaving the next row goes to FuzzyMatch!

Range("F1").Value = "Computing" & Chr(10) & "please" & Chr(10) &
"wait"
Range("F1").Font.ColorIndex = 2
If Range("E1").Interior.ColorIndex = 15 Then
MsgBox "You did not paste formula yet"
GoTo TheTerminator1
Else: GoTo TheTerminator2
End If
TheTerminator2:
r = Range("B" & Rows.Count).End(xlUp).Row
Range("B2:B" & r).Select
Selection.Copy
Range("F2").Select
ActiveSheet.Paste
ActiveSheet.Paste
Application.CutCopyMode = False

Range("F2:F" & r).Select
Selection.Sort Key1:=Range("F2"), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Range("F1").Select
Range("F1").Value = "Computing" & Chr(10) & "please" & Chr(10) &
"wait"

r = Range("F" & Rows.Count).End(xlUp).Row
Range("F1:F" & r).AdvancedFilter Action:=xlFilterCopy,
CopyToRange:=Range( _
"G1"), Unique:=True


r = Range("G" & Rows.Count).End(xlUp).Row
For i = 2 To r
If Range("G" & i) <> "" Then
Range("H" & i).Value = i - 1
Else: GoTo Terminus
End If
Next
Terminus:

LastRowB = Cells(Rows.Count, "B").End(xlUp).Row
LastrowG = Cells(Rows.Count, "G").End(xlUp).Row
Set MyRangeG = Range("G2:G" & LastrowG)
Set MyRangeB = Range("B2:B" & LastRowB)
For Each b In MyRangeB
For Each G In MyRangeG
If b.Value = G.Value Then
b.Offset(, 1).Value = G.Offset(, 1).Value
End If

Next
Next

r = Range("C" & Rows.Count).End(xlUp).Row
Range("C2" & ":" & "C" & r).Interior.ColorIndex = 15
For i = 2 To r
With Range("C" & i).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("C" & i).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("C" & i).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("C" & i).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With

Next i

r = Range("F" & Rows.Count).End(xlUp).Row
Range("F2" & ":" & "F" & r).Interior.ColorIndex = 15
For i = 2 To r
With Range("F" & i).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("F" & i).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("F" & i).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("F" & i).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With

Next i


r = Range("G" & Rows.Count).End(xlUp).Row
Range("G2" & ":" & "G" & r).Interior.ColorIndex = 15
For i = 2 To r
With Range("G" & i).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("G" & i).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("G" & i).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("G" & i).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With

Next i


r = Range("H" & Rows.Count).End(xlUp).Row
Range("H2" & ":" & "H" & r).Interior.ColorIndex = 15

For i = 2 To r
With Range("H" & i).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("H" & i).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("H" & i).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("H" & i).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With

Next i
Range("F1").ClearContents
Range("F1").Font.ColorIndex = 5
Range("F1").Value = "Button" & Chr(10) & "Cleared"
Range("F1").Interior.ColorIndex = 48
Range("G1").Select
Range("G1").Interior.ColorIndex = 15
Range("G1").Font.ColorIndex = 2
Range("G1").Value = "Click" & Chr(10) & "this"


TheTerminator1:
End Sub
 
I think it would help if we could see the code for the 3rd CommandButton's
events. Also, what is the function's name.

--
Rick (MVP - Excel)









- Show quoted text -
Click to expand...

Hi Rick, this is the sixth time I have tried to reply to your message.
Hopefully 7th time lucky!

Function name FuzzyMatch
Code for button;

Private Sub CommandButton3_Click()
Dim i As Long
Dim r As Long
Dim MyRangeB As Range, MyRangeG As Range, b As Range, G As Range
Dim LastRowB As Long, LastrowG As Long

'On leaving the next row goes to FuzzyMatch!

Range("F1").Value = "Computing" & Chr(10) & "please" & Chr(10) &
"wait"
Range("F1").Font.ColorIndex = 2
If Range("E1").Interior.ColorIndex = 15 Then
MsgBox "You did not paste formula yet"
GoTo TheTerminator1
Else: GoTo TheTerminator2
End If
TheTerminator2:
r = Range("B" & Rows.Count).End(xlUp).Row
Range("B2:B" & r).Select
Selection.Copy
Range("F2").Select
ActiveSheet.Paste
ActiveSheet.Paste
Application.CutCopyMode = False

Range("F2:F" & r).Select
Selection.Sort Key1:=Range("F2"), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Range("F1").Select
Range("F1").Value = "Computing" & Chr(10) & "please" & Chr(10) &
"wait"

r = Range("F" & Rows.Count).End(xlUp).Row
Range("F1:F" & r).AdvancedFilter Action:=xlFilterCopy,
CopyToRange:=Range( _
"G1"), Unique:=True


r = Range("G" & Rows.Count).End(xlUp).Row
For i = 2 To r
If Range("G" & i) <> "" Then
Range("H" & i).Value = i - 1
Else: GoTo Terminus
End If
Next
Terminus:

LastRowB = Cells(Rows.Count, "B").End(xlUp).Row
LastrowG = Cells(Rows.Count, "G").End(xlUp).Row
Set MyRangeG = Range("G2:G" & LastrowG)
Set MyRangeB = Range("B2:B" & LastRowB)
For Each b In MyRangeB
For Each G In MyRangeG
If b.Value = G.Value Then
b.Offset(, 1).Value = G.Offset(, 1).Value
End If

Next
Next

r = Range("C" & Rows.Count).End(xlUp).Row
Range("C2" & ":" & "C" & r).Interior.ColorIndex = 15
For i = 2 To r
With Range("C" & i).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("C" & i).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("C" & i).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("C" & i).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With

Next i

r = Range("F" & Rows.Count).End(xlUp).Row
Range("F2" & ":" & "F" & r).Interior.ColorIndex = 15
For i = 2 To r
With Range("F" & i).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("F" & i).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("F" & i).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("F" & i).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With

Next i


r = Range("G" & Rows.Count).End(xlUp).Row
Range("G2" & ":" & "G" & r).Interior.ColorIndex = 15
For i = 2 To r
With Range("G" & i).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("G" & i).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("G" & i).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("G" & i).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With

Next i


r = Range("H" & Rows.Count).End(xlUp).Row
Range("H2" & ":" & "H" & r).Interior.ColorIndex = 15

For i = 2 To r
With Range("H" & i).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("H" & i).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("H" & i).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Range("H" & i).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With

Next i
Range("F1").ClearContents
Range("F1").Font.ColorIndex = 5
Range("F1").Value = "Button" & Chr(10) & "Cleared"
Range("F1").Interior.ColorIndex = 48
Range("G1").Select
Range("G1").Interior.ColorIndex = 15
Range("G1").Font.ColorIndex = 2
Range("G1").Value = "Click" & Chr(10) & "this"


TheTerminator1:
End Sub
 
I think it would help if we could see the code for the 3rd CommandButton's
events. Also, what is the function's name.

--
Rick (MVP - Excel)









- Show quoted text -
Click to expand...

Why is it so hard to register a message on here?
 
ChipButtyMan
Is that range.value = "..." triggering a change event that your
fuzzylogic is trapping?

If so you could wrap your function in
application.enableevents = false

and true at the end. Or you could restructure the event code to not
trigger if the changed cell is F1.

If thats not it post back, and let us know if you have any event code
behind the active sheet

Cheers
Simon
Blog: www.smurfonspreadsheets.net
 
Back
Top