PDA

View Full Version : Solved: Writing in any cell in the range and check the remaining sheets replay



k0st4din
04-07-2013, 02:53 AM
Hi friends,
I have one question, which for me is impossible to happen, despite all the extras offered excel, but with the following wording:
Let's imagine that we have four sheets and columns A1:K65000, for each sheet.
My question is - is there a way when I open any of these 4 sheets and pick any cell (just random) in a range of me to do the following:
Randomly choose my sheet2 (or one, or three, or four), cell B220 (can be any cell) and begin to write a number (in all these cells will write only numbers) eg number 123456.
Are there other ways in sheet1, sheet3, sheet4 - macro to check that in this range A1:K65000, have it somewhere including 123456 if you have to show me the words like "In the sheet?: Cell? - It has the same number "!?
For me it is impossible, but you're the kings of Excel, and may invent something!
Thanks in advance!

mdmackillop
04-07-2013, 04:08 AM
A small sample to try

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim s As String, FirstAddress As String, Msg As String
Dim sht As Worksheet
Dim c As Range

s = Sh.Name & "!" & Target.Address
For Each sht In Sheets
sht.Cells.Interior.ColorIndex = xlNone 'Debug line
With sht.Cells
Set c = .Find(Target, lookat:=xlWhole)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
If sht.Name & "!" & c.Address <> s Then
Msg = Msg & sht.Name & "!" & c.Address & vbCr
c.Interior.ColorIndex = 5 'debug line
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
End With
Next
If Len(Msg) = 0 Then
MsgBox "Number " & Target.Value & " not found"
Else
MsgBox "Number " & Target.Value & " found here" & vbCr & Msg
End If
End Sub

SamT
04-07-2013, 08:49 AM
Dr. Mack,

I always study your code, :bow: but, because I was just :snooze and hadn't had any coffee at all, I had to really. :work:

Then I realized that I needed this in my Personal.xls and came up with:

Uses "For Newbie" style comments.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'This code for OP.
FindDuplicateValues Target
End Sub

Private Sub FindDuplicateValues(ByRef CelToCompare As Range, _
Optional ByRef ShtsToCheck As Collection)
Dim Sht As Worksheet
Dim Cel As Range
Dim FAddFound As String 'Address of first Duplicate Found on Sht.
'Used to end Do Loop.
Dim DupesFound As New Collection
Dim CtCAddress As String
Dim CtCValue As String 'CtC stands for Cell to Compare.

If ShtsToCheck Is Nothing Then Set ShtsToCheck = ThisWorkbook.Sheets
CtCAddress = CelToCompare.Worksheet.Name & "!" & CelToCompare.Address
CtCValue = CelToCompare.Value

For Each Sht In ShtsToCheck
Sht.Cells.Interior.ColorIndex = xlNone 'Debug line 'Left in for OP.

With Sht.Cells
Set Cel = .Find(CtCValue, lookat:=xlWhole)
If Cel Is Nothing Then GoTo CheckNextSheet

FAddFound = Cel.Address

Do
If (Sht.Name & "!" & Cel.Address) = CtCAddress Then GoTo CheckNextCell
DupesFound.Add (Sht.Name & "!" & Cel.Address)
Cel.Interior.ColorIndex = 5 'debug line 'Left in for OP.

CheckNextCell:
Set Cel = .FindNext(Cel)
Loop While Not Cel Is Nothing And Cel.Address <> FAddFound

CheckNextSheet:
End With

Next Sht
''''This code for OP.
If DupesFound.Count = 0 Then
MsgBox "Number " & CtCValue & " not found"
Else
Dim Msg As String
Msg = "Number " & CtCValue & " found here" & vbCr
Dim i As Long
For i = 1 To DupesFound.Count
Msg = Msg & DupesFound(i) & vbCr
MsgBox Msg
Next i
End If
End Sub

mdmackillop
04-07-2013, 09:26 AM
Hi Sam,
I can't get the code to run. It errors on 'Set ShtsToCheck = ThisWorkbook.Sheets'. I don't see the need for this, as you just need to use the Worksheets collection 'For Each Sht In Worksheets'.
BTW, better to use Worksheets in case the Workbook contains Charts.
I'd also keep 'MsgBox Msg' out of the loop!
Neater use of a Collection for the results though.

SamT
04-07-2013, 09:38 AM
I probably won't troubleshoot it till I need it, but

Thanks.

:friends:

k0st4din
04-08-2013, 08:12 AM
Hello,
thank you very much for the quick help from your side.
The first macro works flawlessly, while the second thing I could not get the idea for it, but give me the error.
Thank you very much again!