Search through range on multiple sheets

W

WIGG77

New Member
Joined
Jun 25, 2014
Messages
49
Hi there,
I've searched and searched and everything I try doesn't work for me & I'm going to have to give up and ask for help.
The code below is part of a larger code but this is the part thats not working as intended. I've added the full code at the bottom for reference.

I've not written this from scratch. It's a patchwork of many help files, forums and other peoples work that I have adapted to suit my needs.
Been working flawlessly for 3-4 years now. Just wanted to add some extra automation to it.

Part code. (Line commented out so it's easy to find)
VBA Code: 
ActiveSheet.Range(ANS.Offset(, 0), ANS.Offset(, 0)).Select

    Dim rCell As Range
    Dim rRng As Range
    'For Each rCell In Range("T3:T72")
        If rCell.Value = (ANS) Then
            If rRng Is Nothing Then
                Set rRng = rCell
            Else
                Set rRng = Application.Union(rRng, rCell)
            End If
        End If
    Next

    ActiveSheet.Range(rRng.Offset(, 0), rRng.Offset(, 20)).Select

    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
 
    ActiveSheet.Range(rRng.Offset(, 12), rRng.Offset(, 12)).Value = Date

ANS is derived from an input box.
ANS selection is a serial number selected from column B.
Code search's for serial number selected from column B in T3:T72. When found it highlights certain cells grey and inserts a date.

Works like a charm providing its all on the same sheet.

Doesn't work if the input box selection is on one sheet and serial its looking for is on another. There are no more than 6 sheets at any time in the workbook.

So basically I think it's this line that needs something.

VBA Code: 
For Each rCell In Range("T3:T72")

I've been trying things like

VBA Code: 
Range("$T$3:$T$72")
Range("Sheet1:Sheet2!$T$3:$T$72")
Range(("Sheet1, Sheet2)$T$3:$T$72"))

And so on.
Am I on the correct path here?

Thanks
Dave

Full code. (Line commented out so it's easy to find)

VBA Code: 
Sub SIGNOFF()

Dim ANS As Range
On Error GoTo CANCELED
Set ANS = Application.InputBox("Which Chair do you wish to mark as complete?" & vbNewLine & "Please select chair serial number ", "Completion Notification", Type:=8)
If MsgBox("You are about to sign off " & ANS & " as complete. Are you sure?", vbYesNo) = vbNo Then Exit Sub

   ActiveSheet.Range(ANS.Offset(, -1), ANS.Offset(, 2)).Select
   ActiveSheet.Range(ANS.Offset(, -1), ANS.Offset(, 2)).Font.Name = "3DS LIGHT"
   ActiveSheet.Range(ANS.Offset(, -1), ANS.Offset(, 2)).Font.Bold = True
   ActiveSheet.Range(ANS.Offset(, -1), ANS.Offset(, 2)).Select
   With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 3005476
        .TintAndShade = 0
        .PatternTintAndShade = 0

   ActiveWorkbook.EnvelopeVisible = True

   With ActiveSheet.MailEnvelope
      .Introduction = " This wheelchair has passed final inspection and is ready for despatch"
      .Item.to = ""
      .Item.CC = ""
      .Item.bcc = "*******@rgkwheelchairs.com"
      .Item.Subject = "**RGK CHAIR COMPLETION ALERT** " & ANS & " / " & ANS.Offset(, -1) & " / " & ANS.Offset(, 2) & " is ready for despatch "
      .Item.send
   End With

   ActiveSheet.Range(ANS.Offset(, -1), ANS.Offset(, 2)).Font.Name = "ARIAL"
   ActiveSheet.Range(ANS.Offset(, -1), ANS.Offset(, 2)).Font.Bold = False
   ActiveSheet.Range(ANS.Offset(, -1), ANS.Offset(, 14)).Select
   With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.499984740745262
        .PatternTintAndShade = 0

   ActiveSheet.Range(ANS.Offset(, 3), ANS.Offset(, 3)).Font.Name = "wingdings"
   ActiveSheet.Range(ANS.Offset(, 3), ANS.Offset(, 3)) = "ü"
   ActiveSheet.Range(ANS.Offset(, 5), ANS.Offset(, 11)).Font.Name = "wingdings"
   ActiveSheet.Range(ANS.Offset(, 5), ANS.Offset(, 11)) = "ü"

   ActiveSheet.Range(ANS.Offset(, 0), ANS.Offset(, 0)).Select

    Dim rCell As Range
    Dim rRng As Range
   ' For Each rCell In Range("T3:T72")
        If rCell.Value = (ANS) Then
            If rRng Is Nothing Then
                Set rRng = rCell
            Else
                Set rRng = Application.Union(rRng, rCell)
            End If
        End If
    Next

    ActiveSheet.Range(rRng.Offset(, 0), rRng.Offset(, 20)).Select

    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
 
    ActiveSheet.Range(rRng.Offset(, 12), rRng.Offset(, 12)).Value = Date

ActiveWorkbook.Save
Range("A1").Select
CANCELED:
End With
End With
End With

End Sub
 
Last edited:

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.
Sort by date Sort by votes
Will the value of ANS only be found once on a particular sheet?
 
Upvote 0
Fluff said:
Will the value of ANS only be found once on a particular sheet?
Click to expand...
Not necessarily. Each sheet is one week. If the wheelchair is planned to be built in the due week then they would be in the same sheet. If it couldn't be built in the due week it would be on another sheet.

See the screenshot below of the master sheet. Hopefully it will make more sense. I've just put some random serials in for reference.
Columns A to P are my planner for what is due
Columns S to AN is the section for my manufacturing team

Click complete button
Select Serial in B
Sends notification email and greys out A to P.
Searches T for same serial.
Greys out T to AN
Inserts todays date in AF

Thanks for your time
Dave


Capture.JPG
 
Upvote 0
If the part number occurs more than once on a particular sheet your code will only highlight the 1st instance, rather than all of them. Is that what you want
 
Upvote 0
It doesn't. On this sheet when the message box asks which chair to sign off. I select B5 (GEH123), it highlights off as in picture above.
 
Upvote 0
Ok, how about
VBA Code: 
Sub SIGNOFF()

Dim ANS As Range
On Error GoTo CANCELED
Set ANS = Application.InputBox("Which Chair do you wish to mark as complete?" & vbNewLine & "Please select chair serial number ", "Completion Notification", Type:=8)
If MsgBox("You are about to sign off " & ANS & " as complete. Are you sure?", vbYesNo) = vbNo Then Exit Sub

   With ANS.Offset(, -1).Resize(, 4)
      .Font.Name = "3DS LIGHT"
      .Font.Bold = True
      
      With .Interior
           .Pattern = xlSolid
           .PatternColorIndex = xlAutomatic
           .Color = 3005476
           .TintAndShade = 0
           .PatternTintAndShade = 0
      End With
   End With
   ActiveWorkbook.EnvelopeVisible = True

   With ActiveSheet.MailEnvelope
      .Introduction = " This wheelchair has passed final inspection and is ready for despatch"
      .item.to = ""
      .item.CC = ""
      .item.bcc = "*******@rgkwheelchairs.com"
      .item.Subject = "**RGK CHAIR COMPLETION ALERT** " & ANS & " / " & ANS.Offset(, -1) & " / " & ANS.Offset(, 2) & " is ready for despatch "
      .item.send
   End With

   With ANS.Offset(, -1).Resize(, 4)
      .Font.Name = "ARIAL"
      .Font.Bold = False
      With .Interior
           .Pattern = xlSolid
           .PatternColorIndex = xlAutomatic
           .ThemeColor = xlThemeColorDark1
           .TintAndShade = -0.499984740745262
           .PatternTintAndShade = 0
      End With
   End With
   With ANS.Offset(, 3)
      .Font.Name = "wingdings"
      .Value = "ü"
   End With
   With ANS.Offset(, 5).Resize(, 7)
      .Font.Name = "wingdings"
      .Value = "ü"
   End With


    Dim rCell As Range
    Dim i As Long
    For i = 4 To Sheets.Count
        Set rCell = Sheets(i).Range("T3:T72").Find(ANS, , , xlWhole, , , False, , False)
        If Not rCell Is Nothing Then
            With rCell.Resize(, 21).Interior
                 .Pattern = xlSolid
                 .PatternColorIndex = xlAutomatic
                 .ThemeColor = xlThemeColorDark1
                 .TintAndShade = -0.249977111117893
                 .PatternTintAndShade = 0
            End With
            rCell.Offset(, 12).Value = Date
          End If
          Set rCell = Nothing
         Next i
   ActiveWorkbook.Save
   Range("A1").Select
CANCELED:
End Sub
 
Upvote 0
Solution
You're welcome & thanks for the feedback.
 
Upvote 0
You must log in or register to reply here.

Similar threads

W
  • Question
Macro enable shared file mystery
Replies
2
Views
318
WIGG77
W
K
  • Solved
formating question
Replies
3
Views
71
Micron
M
J
  • Question
Macro to affect cell background color
Replies
3
Views
204
mumps
mumps
T
  • Question
Filling alternate cells with two colours?
Replies
3
Views
187
Joe4
Joe4
I
  • Solved
duplicating spreadsheet without losing formulas in cells
Replies
8
Views
213
MARK858
MARK858

Forum statistics

Threads
1,214,827
Messages
6,121,806
Members
449,048
Latest member
greyangel23

Share this page

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