Unique ID on different sheets

[Sue]

Hi All

Tis the season of goodwill perhaps all you experts out there will help with
my small problem.

Several days a week I receive emails in the following format

4161,WM2899 ,140,84

I have no problem copying and pasting in column A of Sheet1 then Text to
Columns
I may have as many as 400 rows as above all will be different the 1st 4
digits 4161 are of no use whatsoever so they have to be deleted -- WM2899 is
the ID number and could be anywhere in Column A on any of the 30 other sheets
in the workbook all with different names on finding the ID number on whatever
sheet or row I need the digits 140 to enter the 1st empty Column Cell on the
row the ID number is found -- Likewise the digits 84 in the next empty column
cell adjacent to the 140. If a macro can do this I would place a command
button on Sheet 1 and assign the macro.

Any help much appreciated

 

[Joel]

Sub FillinData()

RowCount = 1
With Sheets("Sheet1")
Do While .Range("B" & RowCount) <> ""
ID = .Range("B" & RowCount)
Val1 = .Range("C" & RowCount)
Val2 = .Range("D" & RowCount)
For Each sh In ThisWorkbook.Sheets
If sh.Name <> "Sheet1" Then
Set c = sh.Columns("A:A").Find(what:=ID, _
LookIn:=xlValues)
If Not c Is Nothing Then
c.Offset(0, 1) = Val1
c.Offset(0, 2) = Val2
End If
End If
Next sh

RowCount = RowCount + 1
Loop
End With
End Sub

 

[Sue]

Hi Joel

Thank you for the fast response -- I set up a new workbook with just 4
sheets and about 20 rows in Column A in each sheet with the ID numbers mixed
up on each sheet ran the macro and it put everything in colums B & C
correctly -- however I ran the macro again and it did not then put the info
in columns D & E it appears to have overwritten columns B & C -- In fact I
changed some of the values in sheet 1 and the same thing happened.

'Am I doing something wrong??

 

[Incidental]

Hi Sue

The code below should do what your after though it is a little messy
but it will give you an idea of a way round your problem

Option Explicit
Dim WkSh As Worksheet
Dim fCell As Range
Dim fCellAdd As String
Dim MyCell, MyRng As Range
Dim LastRow As Integer

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False
'Prevent the screen flickering during update
Sheets("Sheet1").Activate
'Set the sheet that holds your search criteria
LastRow = [A65535].End(xlUp).Row
'Find the last used row in column A
Set MyRng = Range("A1:A" & LastRow)
'Set your range
For Each MyCell In MyRng
'Set a loop through the cells in the range
For Each WkSh In ThisWorkbook.Worksheets
WkSh.Activate
'Set a loop through the worksheets
If WkSh.Name = "Sheet1" Then GoTo line1
Set fCell = [A:A].Find(MyCell.Value, Lookat:=xlWhole)
'Search for the ID number
If Not fCell Is Nothing Then
'If found continue
fCellAdd = fCell.Address
'Store the cell address of the found cell
Do
fCell.End(xlToRight).Offset(0, 1).Value = MyCell.Offset(0, 1)
fCell.End(xlToRight).Offset(0, 1).Value = MyCell.Offset(0, 2)
'Set you values to the required cells
Set fCell = [A:A].FindNext(fCell)
'Check for more instances in the same sheet
Loop While Not fCell Is Nothing And fCell.Address <> fCellAdd
'Check the address against the first found to prevent looping
End If
line1:
Next WkSh
Next MyCell
Application.ScreenUpdating = True
'Return the screenupdating setting to true
End Sub


hope this helps

Steve

 

[Sue]

Hi Steve

Thanks for the reply but I've been struggling not very good at VBA learn on
the hoof viewing this forum and others -- after text to columns the ID number
is in column C on sheet1 and the others are in D & E columns been changing
them all around in your code - however no values go into the cells against
the ID number when found on the other sheets not matter what combination I
use -- any idea's ??

 

[Joel]

I forgot to put in first empty column. New code fixes the problem

Sub FillinData()
Dim LastCol(1)

ReDim BlankCol(Sheets.Count)

For Each sh In ThisWorkbook.Sheets

ColumnCount = 1
Do While WorksheetFunction.CountA(sh.Columns(ColumnCount)) > 0
ColumnCount = ColumnCount + 1
Loop
BlankCol(sh.Index) = ColumnCount
Next sh

RowCount = 1
With Sheets("Sheet1")
Do While .Range("B" & RowCount) <> ""
ID = .Range("B" & RowCount)
Val1 = .Range("C" & RowCount)
Val2 = .Range("D" & RowCount)
For Each sh In ThisWorkbook.Sheets
If sh.Name <> "Sheet1" Then
Set c = sh.Columns("A:A").Find(what:=ID, _
LookIn:=xlValues)
If Not c Is Nothing Then
c.Offset(0, BlankCol(sh.Index) - 1) = Val1
c.Offset(0, BlankCol(sh.Index)) = Val2
End If
End If
Next sh

RowCount = RowCount + 1
Loop
End With
End Sub

 

[Incidental]

Hi Sue

Just a quick reply to say that Joel's code seems to work grand so i
would go with that as it is a much tidier and more readable code. The
forums here on google hold a wealth of knowledge and if you refine
your searches you can almost always find what your looking for also i
don't mean to sound rude but the vba help in excel is great it holds
loads of examples and is very useful. Also you should have a look at
http://support.microsoft.com/kb/829070 on MSDN which is a great
article for beginners. I wish you the best of luck with your
programming.

Steve

 

[Joel]

trhank you for the compliment! I have taken a lot of college software
courses where grades were dependant on readable code. Simply adding spaces
and adding "_" character for line continuation are simple metthods for making
code readable. One teacher used "White Space Area" as a criteea for
readablity.