Home |
Search |
Today's Posts |
|
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 -- Many Thanks Sue |
#2
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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" wrote: 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 -- Many Thanks Sue |
#3
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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?? -- Many Thanks Sue "Joel" wrote: 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" wrote: 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 -- Many Thanks Sue |
#4
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
#5
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 ?? -- Many Thanks Sue "Incidental" wrote: 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Multiple sheets, one user form, and a unique ID | Excel Programming | |||
Extract Rows Unique to Two Sheets | Excel Discussion (Misc queries) | |||
Selecting sheets with unique names | Excel Programming | |||
Find Unique Records from two sheets | Excel Programming | |||
defining unique range of cells for different sheets as the same n. | Excel Discussion (Misc queries) |