Activating Sheet which a name contains after running Macro

[exceluser9]

Hi There,

I'm Using Below code to colour specific words in the next sheet which contains the name Double_Check_Results and it works fine & I want to activate the the same sheet after running the macro. Can anyone help with amendment?

Sub HighlightCells()
Dim WB As Workbook
Dim i As Long
Dim x As Long
Dim Cell As Object
'just incase
On Error Resume Next
'iterate through all workbooks opened
For Each WB In Application.Workbooks
'going to loop through from left to search for file name in somewhere centre
'look for the file name that starts with this
For i = 1 To Len(WB.Name)




If Mid(WB.Name, i, Len("Double_Check_Results")) = "Double_Check_Results" Then
'if the code gets here it means that the file was found
'time to iterate through all cells on active sheet and highlight as essential
For Each Cell In WB.Sheets("Sheet1").UsedRange




'going to loop through len of each cells to find these characters within
For x = 1 To Len(Cell.Value)








'check if value is red
If Mid(Cell, x, Len(VBA.LCase("RED"))) = "RED" Then
'do the necessary coloring
Cell.Interior.Color = vbRed
Cell.Font.Color = vbWhite
'quit for
Exit For
End If
'for amber
If Mid(Cell, x, Len(VBA.LCase("Orange"))) = "AMBER" Then
'do the necessary coloring
Cell.Interior.Color = VBA.RGB(255, 153, 0)
Cell.Font.Color = vbWhite
'quit for
Exit For
End If


'check if value is red
If Mid(Cell, x, Len(VBA.LCase("Red"))) = "Red" Then
'do the necessary coloring
Cell.Interior.Color = vbRed
Cell.Font.Color = vbWhite
'quit for
Exit For
End If
'for amber
If Mid(Cell, x, Len(VBA.LCase("Orange"))) = "Failed" Then
'do the necessary coloring
Cell.Interior.Color = VBA.RGB(255, 153, 0)
Cell.Font.Color = vbWhite
'quit for
Exit For
End If


'for amber
If Mid(Cell, x, Len(VBA.LCase("Orange"))) = "Amber" Then
'do the necessary coloring
Cell.Interior.Color = VBA.RGB(255, 153, 0)
Cell.Font.Color = vbWhite
'quit for
Exit For
End If


'for green
If Mid(Cell, x, Len(VBA.LCase("BLUE"))) = "BLUE" Then
'do the necessary coloring
Cell.Interior.Color = VBA.RGB(0, 128, 0)
Cell.Font.Color = vbBlack
'quit for
Exit For
End If








Next x












Next Cell




'quit procedure




Exit Sub
End If




Next i




Next WB




MsgBox "No workbook could be found, please open the required files and re-try", vbInformation




End Sub

 

[Roderick_E]

Dim wsh as Worksheet
set wsh = wb.sheets("Double_Check_Results")


then at the end you can

wsh.activate

 

[exceluser9]

Hi Sir, I tried but it didn't work. Please can you provide with the entire code where it has to be placed exactly?

 

[Roderick_E]

Hello based on your code, the new bit goes here:


Sub HighlightCells()
Dim WB As Workbook
Dim i As Long
Dim x As Long
Dim Cell As Object
Dim wsh as Worksheet
'just incase
On Error Resume Next
'iterate through all workbooks opened
For Each WB In Application.Workbooks
'going to loop through from left to search for file name in somewhere centre
'look for the file name that starts with this
For i = 1 To Len(WB.Name)








If Mid(WB.Name, i, Len("Double_Check_Results")) = "Double_Check_Results" Then
'if the code gets here it means that the file was found
'time to iterate through all cells on active sheet and highlight as essential
For Each Cell In WB.Sheets("Sheet1").UsedRange








'going to loop through len of each cells to find these characters within
For x = 1 To Len(Cell.Value)
















'check if value is red
If Mid(Cell, x, Len(VBA.LCase("RED"))) = "RED" Then
'do the necessary coloring
Cell.Interior.Color = vbRed
Cell.Font.Color = vbWhite
'quit for
Exit For
End If
'for amber
If Mid(Cell, x, Len(VBA.LCase("Orange"))) = "AMBER" Then
'do the necessary coloring
Cell.Interior.Color = VBA.RGB(255, 153, 0)
Cell.Font.Color = vbWhite
'quit for
Exit For
End If




'check if value is red
If Mid(Cell, x, Len(VBA.LCase("Red"))) = "Red" Then
'do the necessary coloring
Cell.Interior.Color = vbRed
Cell.Font.Color = vbWhite
'quit for
Exit For
End If
'for amber
If Mid(Cell, x, Len(VBA.LCase("Orange"))) = "Failed" Then
'do the necessary coloring
Cell.Interior.Color = VBA.RGB(255, 153, 0)
Cell.Font.Color = vbWhite
'quit for
Exit For
End If




'for amber
If Mid(Cell, x, Len(VBA.LCase("Orange"))) = "Amber" Then
'do the necessary coloring
Cell.Interior.Color = VBA.RGB(255, 153, 0)
Cell.Font.Color = vbWhite
'quit for
Exit For
End If




'for green
If Mid(Cell, x, Len(VBA.LCase("BLUE"))) = "BLUE" Then
'do the necessary coloring
Cell.Interior.Color = VBA.RGB(0, 128, 0)
Cell.Font.Color = vbBlack
'quit for
Exit For
End If
















Next x
























Next Cell








'quit procedure








Exit Sub
End If








Next i






set wsh = WB.sheets("Double_Check_Results")
wsh.activate
Next WB








MsgBox "No workbook could be found, please open the required files and re-try", vbInformation








End Sub

 

[exceluser9]

Hi Sir,

I Tried it but it didnt take me to the requested sheet after clicking the button in other sheet where the shhet name contains. Any suggestion?

It just gave me the results.

 

[Roderick_E]

let's do this, forget everything I wrote before....
Right before the Exit Sub line.... put this:

activeworkbook.sheets("[COLOR=#333333]Double_Check_Results").activate[/COLOR]

 

[exceluser9]

Hi Sir,

I have tried but this didn't work through. Please could you try and let me know.

 

[exceluser9]

Hi Sir,

Any Suggestions?

 

[exceluser9]

Hi Sir,

Any suggestions?