Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Codes needed to update wages
Hi,
Column A of Sheet1 holds the identity numbers of about 200 casual members of our staffs. Column F shows their current weekly wages. I need a simple macro that allows me to update the weekly wages for some of these members by 4.5% from a list of their identity numbers shown in Column A of Sheet2. Any help is much appreciated. TIA Tom |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Codes needed to update wages
Here one shot at it:
Sub payBoost() Dim lr As Long, sh As Worksheet, rng As Range Dim fRng As Range Set sh = ActiveSheet lr = sh.Cells(Rows.Count, 1).End(xlUp).Row Set rng = sh.Range("A2:A" & lr) Set c = rng.Find(InputBox("Enter an ID number.", "ID NUMBER"), _ LookIn:=xlValues) If Not c Is Nothing Then Set fRng = Range("F" & c.Row) fRng = fRng.Value + (fRng.Value * 0.045) End If End Sub This will ask the user to input an identification number. It will then find that number in column A and add 4.5% to the amount shown in column F and post the new value to column F. "Tom" wrote in message ... Hi, Column A of Sheet1 holds the identity numbers of about 200 casual members of our staffs. Column F shows their current weekly wages. I need a simple macro that allows me to update the weekly wages for some of these members by 4.5% from a list of their identity numbers shown in Column A of Sheet2. Any help is much appreciated. TIA Tom |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Codes needed to update wages
That was quick. It does what you intended it to do. However it
does not avoid the hard work of having to enter those numbers one at a time. I was looking for a way for the program to sequentially read the numbers in Sheet2, finds its corresponding number in Sheet1 and then carry out the update. This way it saves a lot of work. See if you can figure out a way for the program to do just that. Thank you for your eforts. "JLGWhiz" wrote in message ... Here one shot at it: Sub payBoost() Dim lr As Long, sh As Worksheet, rng As Range Dim fRng As Range Set sh = ActiveSheet lr = sh.Cells(Rows.Count, 1).End(xlUp).Row Set rng = sh.Range("A2:A" & lr) Set c = rng.Find(InputBox("Enter an ID number.", "ID NUMBER"), _ LookIn:=xlValues) If Not c Is Nothing Then Set fRng = Range("F" & c.Row) fRng = fRng.Value + (fRng.Value * 0.045) End If End Sub This will ask the user to input an identification number. It will then find that number in column A and add 4.5% to the amount shown in column F and post the new value to column F. "Tom" wrote in message ... Hi, Column A of Sheet1 holds the identity numbers of about 200 casual members of our staffs. Column F shows their current weekly wages. I need a simple macro that allows me to update the weekly wages for some of these members by 4.5% from a list of their identity numbers shown in Column A of Sheet2. Any help is much appreciated. TIA Tom |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Codes needed to update wages
Tom,
In defense of JLGWhiz, you did say "...allows me to update the weekly wages for some of these members by..." And that's what his code does. Had you initially requested code to update them all, I'm certain he would have provided exactly that. I'm certain that he overlooked, as I did, the at-the-end of the post reference to identity numbers on sheet2. So, try this code in a copy of your workbook and see if it does what you want or not. You'll need to change the Const values at the beginning of it after you do the copy to match worksheet names and column IDs in your workbook before running it. Sub UpdateWages() 'alter Const values as needed for your workbook Const wageSheetName = "SheetWithWages" ' sheet1? Const firstWGIDRow = 2 ' first row w/employee id Const wsIDColumn = "A" Const wswagecolumn = "F" Const amtOfRaise = 0.045 ' 4.5% Const updateListSheetName = "RaiseListSheet" ' sheet2? Const lsIDColumn = "A" Dim wgWS As Worksheet Dim wgIdList As Range Dim anywgID As Range Dim lsWS As Worksheet Dim lsIDList As Range Dim anylsID As Range Set wgWS = ThisWorkbook.Worksheets(wageSheetName) Set wgIdList = wgWS.Range(wsIDColumn & firstWGIDRow & ":" _ & wgWS.Range(wsIDColumn & Rows.Count).End(xlUp).Address) Set lsWS = ThisWorkbook.Worksheets(updateListSheetName) Set lsIDList = lsWS.Range(lsIDColumn & ":" & lsIDColumn) For Each anywgID In wgIdList Set anylsID = lsIDList.Find(What:=anywgID, _ LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, _ SearchDirection:=xlNext, MatchCase:=False, _ SearchFormat:=False) If Not anylsID Is Nothing Then 'found a match wgWS.Range(wswagecolumn & anywgID.Row) = _ wgWS.Range(wswagecolumn & anywgID.Row) * (1 + amtOfRaise) End If Next Set wgIdList = Nothing Set lsIDList = Nothing Set wgWS = Nothing Set lsWS = Nothing End Sub "Tom" wrote: That was quick. It does what you intended it to do. However it does not avoid the hard work of having to enter those numbers one at a time. I was looking for a way for the program to sequentially read the numbers in Sheet2, finds its corresponding number in Sheet1 and then carry out the update. This way it saves a lot of work. See if you can figure out a way for the program to do just that. Thank you for your eforts. "JLGWhiz" wrote in message ... Here one shot at it: Sub payBoost() Dim lr As Long, sh As Worksheet, rng As Range Dim fRng As Range Set sh = ActiveSheet lr = sh.Cells(Rows.Count, 1).End(xlUp).Row Set rng = sh.Range("A2:A" & lr) Set c = rng.Find(InputBox("Enter an ID number.", "ID NUMBER"), _ LookIn:=xlValues) If Not c Is Nothing Then Set fRng = Range("F" & c.Row) fRng = fRng.Value + (fRng.Value * 0.045) End If End Sub This will ask the user to input an identification number. It will then find that number in column A and add 4.5% to the amount shown in column F and post the new value to column F. "Tom" wrote in message ... Hi, Column A of Sheet1 holds the identity numbers of about 200 casual members of our staffs. Column F shows their current weekly wages. I need a simple macro that allows me to update the weekly wages for some of these members by 4.5% from a list of their identity numbers shown in Column A of Sheet2. Any help is much appreciated. TIA Tom . |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Codes needed to update wages
Wow! You are very methodical and it performs exactly what I hope it would
do. Thank you very much. I have a slightly similar request. This time getting back some data. Much obliged if you can help with this task as outlined below: Read a list of column names from two open workbooks - MyWorkbook1 in Sheet1, starting from Column2 Row 3, then find the same name in Myworkbook2. Copy a set of 5 row values next to its right, then paste it back in MyWorkbook1 next to the right and stop at the end of the list. Skip if a name is not found. "JLatham" wrote in message ... Tom, In defense of JLGWhiz, you did say "...allows me to update the weekly wages for some of these members by..." And that's what his code does. Had you initially requested code to update them all, I'm certain he would have provided exactly that. I'm certain that he overlooked, as I did, the at-the-end of the post reference to identity numbers on sheet2. So, try this code in a copy of your workbook and see if it does what you want or not. You'll need to change the Const values at the beginning of it after you do the copy to match worksheet names and column IDs in your workbook before running it. Sub UpdateWages() 'alter Const values as needed for your workbook Const wageSheetName = "SheetWithWages" ' sheet1? Const firstWGIDRow = 2 ' first row w/employee id Const wsIDColumn = "A" Const wswagecolumn = "F" Const amtOfRaise = 0.045 ' 4.5% Const updateListSheetName = "RaiseListSheet" ' sheet2? Const lsIDColumn = "A" Dim wgWS As Worksheet Dim wgIdList As Range Dim anywgID As Range Dim lsWS As Worksheet Dim lsIDList As Range Dim anylsID As Range Set wgWS = ThisWorkbook.Worksheets(wageSheetName) Set wgIdList = wgWS.Range(wsIDColumn & firstWGIDRow & ":" _ & wgWS.Range(wsIDColumn & Rows.Count).End(xlUp).Address) Set lsWS = ThisWorkbook.Worksheets(updateListSheetName) Set lsIDList = lsWS.Range(lsIDColumn & ":" & lsIDColumn) For Each anywgID In wgIdList Set anylsID = lsIDList.Find(What:=anywgID, _ LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, _ SearchDirection:=xlNext, MatchCase:=False, _ SearchFormat:=False) If Not anylsID Is Nothing Then 'found a match wgWS.Range(wswagecolumn & anywgID.Row) = _ wgWS.Range(wswagecolumn & anywgID.Row) * (1 + amtOfRaise) End If Next Set wgIdList = Nothing Set lsIDList = Nothing Set wgWS = Nothing Set lsWS = Nothing End Sub |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Codes needed to update wages
I'm a little confused by "Copy a set of 5 rows next to its right..."
Let's say we are looking at the first name in MyWorkbook 1 (at B3) and have found a match in MyWorkbook2 (at what cell?) then what rows/address range gets copied, AND will new rows need to be inserted into MyWorkbook1 to paste the information into. Just to make su colums go up and down the sheet, rows go across it. So if you can explain it something like this: Match name in column B of workbook1 to name in column ?? of workbook2, then copy 5 rows from workbook2 to workbook1, inserting new rows as needed. Example: Cell in workbook 1 B3, matches ??## in workbook2, copy ??## to ??##+4 into workbook1 starting at ??#. I need the column IDs for ?? and the row numbers for ## and #. "Tom" wrote: Wow! You are very methodical and it performs exactly what I hope it would do. Thank you very much. I have a slightly similar request. This time getting back some data. Much obliged if you can help with this task as outlined below: Read a list of column names from two open workbooks - MyWorkbook1 in Sheet1, starting from Column2 Row 3, then find the same name in Myworkbook2. Copy a set of 5 row values next to its right, then paste it back in MyWorkbook1 next to the right and stop at the end of the list. Skip if a name is not found. "JLatham" wrote in message ... Tom, In defense of JLGWhiz, you did say "...allows me to update the weekly wages for some of these members by..." And that's what his code does. Had you initially requested code to update them all, I'm certain he would have provided exactly that. I'm certain that he overlooked, as I did, the at-the-end of the post reference to identity numbers on sheet2. So, try this code in a copy of your workbook and see if it does what you want or not. You'll need to change the Const values at the beginning of it after you do the copy to match worksheet names and column IDs in your workbook before running it. Sub UpdateWages() 'alter Const values as needed for your workbook Const wageSheetName = "SheetWithWages" ' sheet1? Const firstWGIDRow = 2 ' first row w/employee id Const wsIDColumn = "A" Const wswagecolumn = "F" Const amtOfRaise = 0.045 ' 4.5% Const updateListSheetName = "RaiseListSheet" ' sheet2? Const lsIDColumn = "A" Dim wgWS As Worksheet Dim wgIdList As Range Dim anywgID As Range Dim lsWS As Worksheet Dim lsIDList As Range Dim anylsID As Range Set wgWS = ThisWorkbook.Worksheets(wageSheetName) Set wgIdList = wgWS.Range(wsIDColumn & firstWGIDRow & ":" _ & wgWS.Range(wsIDColumn & Rows.Count).End(xlUp).Address) Set lsWS = ThisWorkbook.Worksheets(updateListSheetName) Set lsIDList = lsWS.Range(lsIDColumn & ":" & lsIDColumn) For Each anywgID In wgIdList Set anylsID = lsIDList.Find(What:=anywgID, _ LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, _ SearchDirection:=xlNext, MatchCase:=False, _ SearchFormat:=False) If Not anylsID Is Nothing Then 'found a match wgWS.Range(wswagecolumn & anywgID.Row) = _ wgWS.Range(wswagecolumn & anywgID.Row) * (1 + amtOfRaise) End If Next Set wgIdList = Nothing Set lsIDList = Nothing Set wgWS = Nothing Set lsWS = Nothing End Sub . |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Codes needed to update wages
At the risk of getting way ahead of myself, I wrote the following code based
on what I am guessing you really want, and my idea of that is: match names on 2 sheets in 2 different workbooks, and when a match is found, then copy 5 COLUMNS next to the match in the second workbook into the first one. So if you find a match in 2nd workbook at B33 (name in first WB at B4) then copy C33:G33 from 2nd workbook into C4:G4 of the first one. The various column IDs are definable in the code. Here's that code (note that it prompts you for the second workbook, so that one should not be open when you run the macro). I've tried to keep the lines short so that the system here doesn't mess things up. Check after you copy the code for any red lines in your code, that just means that whatever is red probably should be at the end of the line above it. Sub CopyFrom2ndWorkbook() 'change these Const values as required 'name of the worksheet in this workbook 'to copy data into, is also the sheet 'with the source list of names Const destinationSheetName = "Sheet1" 'first row with names in it Const destSheet1stNameRow = 2 'column with the names in it Const destSheetNamesCol = "B" '1st column to copy information into Const destSheet1stCopyCol = "C" 'last column to copy information into Const destSheetLastCopyCol = "G" 'information about worksheet in the other 'workbook (one that will be opened and copied from) Const sourceSheetName = "2ksPublicAssistance (3)" Const srcSheetNamesCol = "B" 'first row with names in it Const srcSheet1stNameRow = 2 'first column to copy from Const srcSheet1stCopyCol = "C" 'last column to copy from Const srcSheetLastCopyCol = "G" Dim srcWB As Workbook ' will be copy from workbook Dim srcWS As Worksheet ' will be copy from sheet Dim srcNamesList As Range Dim anySrcName As Range Dim srcCopyRange As Range Dim srcWBName As String Dim destWS As Worksheet ' sheet in this workbook Dim destNamesList As Range Dim anyDestName As Range Dim destCopyRange As Range 'prompt user to open the other workbook srcWBName = Application.GetOpenFilename If UCase(Trim(srcWBName)) = "FALSE" Then 'user cancelled the get filename operation Exit Sub End If Application.ScreenUpdating = False 'open w/o updating links and as Read Only Application.DisplayAlerts = False Workbooks.Open srcWBName, False, True Application.DisplayAlerts = True 'opened book becomes active Set srcWB = ActiveWorkbook 'back to this workbook ThisWorkbook.Activate Set srcWS = srcWB.Worksheets(sourceSheetName) Set srcNamesList = srcWS.Range(srcSheetNamesCol & srcSheet1stNameRow _ & ":" & srcWS.Range(srcSheetNamesCol & Rows.Count).End(xlUp).Address) Set destWS = ThisWorkbook.Worksheets(destinationSheetName) Set destNamesList = destWS.Range(destSheetNamesCol & destSheet1stNameRow _ & ":" & destWS.Range(destSheetNamesCol & Rows.Count).End(xlUp).Address) 'note that in VB, case is important: Bill does not = BILL For Each anyDestName In destNamesList For Each anySrcName In srcNamesList If anySrcName = anyDestName Then 'have a match 'NOTE: number of columns in each range must be same 'not their addresses, but total number of columns, as 'C#:G# = 5 columns Set srcCopyRange = srcWS.Range(srcSheet1stCopyCol _ & anySrcName.Row _ & ":" & srcSheetLastCopyCol & anySrcName.Row) Set destCopyRange = destWS.Range(destSheet1stCopyCol & anyDestName.Row _ & ":" & destSheetLastCopyCol & anyDestName.Row) destCopyRange.Value = srcCopyRange.Value 'we can quit now that we found the match Exit For ' exit the anySrcName loop End If Next Next 'housekeeping Set destNamesList = Nothing Set srcNamesList = Nothing Set srcWS = Nothing Set destWS = Nothing 'close the other workbook, do not save changes Application.DisplayAlerts = False srcWB.Close False Application.DisplayAlerts = True Set srcWB = Nothing MsgBox "Copy from:" & vbCrLf & srcWBName & vbCrLf & "Completed", _ vbOKOnly + vbInformation, "Task Finished" End Sub "Tom" wrote: Wow! You are very methodical and it performs exactly what I hope it would do. Thank you very much. I have a slightly similar request. This time getting back some data. Much obliged if you can help with this task as outlined below: Read a list of column names from two open workbooks - MyWorkbook1 in Sheet1, starting from Column2 Row 3, then find the same name in Myworkbook2. Copy a set of 5 row values next to its right, then paste it back in MyWorkbook1 next to the right and stop at the end of the list. Skip if a name is not found. "JLatham" wrote in message ... Tom, In defense of JLGWhiz, you did say "...allows me to update the weekly wages for some of these members by..." And that's what his code does. Had you initially requested code to update them all, I'm certain he would have provided exactly that. I'm certain that he overlooked, as I did, the at-the-end of the post reference to identity numbers on sheet2. So, try this code in a copy of your workbook and see if it does what you want or not. You'll need to change the Const values at the beginning of it after you do the copy to match worksheet names and column IDs in your workbook before running it. Sub UpdateWages() 'alter Const values as needed for your workbook Const wageSheetName = "SheetWithWages" ' sheet1? Const firstWGIDRow = 2 ' first row w/employee id Const wsIDColumn = "A" Const wswagecolumn = "F" Const amtOfRaise = 0.045 ' 4.5% Const updateListSheetName = "RaiseListSheet" ' sheet2? Const lsIDColumn = "A" Dim wgWS As Worksheet Dim wgIdList As Range Dim anywgID As Range Dim lsWS As Worksheet Dim lsIDList As Range Dim anylsID As Range Set wgWS = ThisWorkbook.Worksheets(wageSheetName) Set wgIdList = wgWS.Range(wsIDColumn & firstWGIDRow & ":" _ & wgWS.Range(wsIDColumn & Rows.Count).End(xlUp).Address) Set lsWS = ThisWorkbook.Worksheets(updateListSheetName) Set lsIDList = lsWS.Range(lsIDColumn & ":" & lsIDColumn) For Each anywgID In wgIdList Set anylsID = lsIDList.Find(What:=anywgID, _ LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, _ SearchDirection:=xlNext, MatchCase:=False, _ SearchFormat:=False) If Not anylsID Is Nothing Then 'found a match wgWS.Range(wswagecolumn & anywgID.Row) = _ wgWS.Range(wswagecolumn & anywgID.Row) * (1 + amtOfRaise) End If Next Set wgIdList = Nothing Set lsIDList = Nothing Set wgWS = Nothing Set lsWS = Nothing End Sub . |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Codes needed to update wages
"JLatham" wrote in message
... I'm a little confused by "Copy a set of 5 rows next to its right..." No. Copy a set of 5 row values next to its right, i.e. next 5 cells to its right along that row. These are the next 5 pieces of information for that particular person like, Address, Post Code, Phone No., Mobile No. and Starting Date. Let's say we are looking at the first name in MyWorkbook 1 (at B3) and have found a match in MyWorkbook2 (at what cell?) then what rows/address range gets copied, AND will new rows need to be inserted into MyWorkbook1 to paste the information into. Just to make su colums go up and down the sheet, rows go across it. So if you can explain it something like this: Match name in column B of workbook1 to name in column ?? of workbook2, then copy 5 rows from workbook2 to workbook1, inserting new rows as needed. Example: Cell in workbook 1 B3, matches ??## in workbook2, copy ??## to ??##+4 into workbook1 starting at ??#. I need the column IDs for ?? and the row numbers for ## and #. "Tom" wrote: Wow! You are very methodical and it performs exactly what I hope it would do. Thank you very much. I have a slightly similar request. This time getting back some data. Much obliged if you can help with this task as outlined below: Read a list of column names from two open workbooks - MyWorkbook1 in Sheet1, starting from Column2 Row 3, then find the same name in Myworkbook2. Copy a set of 5 row values next to its right, then paste it back in MyWorkbook1 next to the right and stop at the end of the list. Skip if a name is not found. "JLatham" wrote in message ... Tom, In defense of JLGWhiz, you did say "...allows me to update the weekly wages for some of these members by..." And that's what his code does. Had you initially requested code to update them all, I'm certain he would have provided exactly that. I'm certain that he overlooked, as I did, the at-the-end of the post reference to identity numbers on sheet2. So, try this code in a copy of your workbook and see if it does what you want or not. You'll need to change the Const values at the beginning of it after you do the copy to match worksheet names and column IDs in your workbook before running it. Sub UpdateWages() 'alter Const values as needed for your workbook Const wageSheetName = "SheetWithWages" ' sheet1? Const firstWGIDRow = 2 ' first row w/employee id Const wsIDColumn = "A" Const wswagecolumn = "F" Const amtOfRaise = 0.045 ' 4.5% Const updateListSheetName = "RaiseListSheet" ' sheet2? Const lsIDColumn = "A" Dim wgWS As Worksheet Dim wgIdList As Range Dim anywgID As Range Dim lsWS As Worksheet Dim lsIDList As Range Dim anylsID As Range Set wgWS = ThisWorkbook.Worksheets(wageSheetName) Set wgIdList = wgWS.Range(wsIDColumn & firstWGIDRow & ":" _ & wgWS.Range(wsIDColumn & Rows.Count).End(xlUp).Address) Set lsWS = ThisWorkbook.Worksheets(updateListSheetName) Set lsIDList = lsWS.Range(lsIDColumn & ":" & lsIDColumn) For Each anywgID In wgIdList Set anylsID = lsIDList.Find(What:=anywgID, _ LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, _ SearchDirection:=xlNext, MatchCase:=False, _ SearchFormat:=False) If Not anylsID Is Nothing Then 'found a match wgWS.Range(wswagecolumn & anywgID.Row) = _ wgWS.Range(wswagecolumn & anywgID.Row) * (1 + amtOfRaise) End If Next Set wgIdList = Nothing Set lsIDList = Nothing Set wgWS = Nothing Set lsWS = Nothing End Sub . |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
Codes needed to update wages
This time round I'm the one that is confused. I mentioned that the workbooks
are, MyWorkbook1 in Sheet1 starting cursor position Column2 Row 3 (destination) and MyWorkbook2 (source) - no other parameters are needed for the latter. Both are open. Using those information it should shorten the codes somewhat. Also, after a source name is found, can you do an offset like, activecell.offset(0, 1).range("A1:A5").select to copy the 5 cells on the right, bring it back to MyWorkbook1, do another offset, activecell.offset(0, 1).select and paste?Then reposition the cursor if needed. The first line that stumped me is: Set srcNamesList = srcWS.Range(srcSheetNamesCol & srcSheet1stNameRow _ & ":" & srcWS.Range(srcSheetNamesCol & Rows.Count).End(xlUp).Address) What are the items that I have to replace? I never learned VBA but know how to use Excel's automatic macro procedure. So, if you can modify some of the lines it would be a great help. Thanks! "JLatham" wrote in message ... At the risk of getting way ahead of myself, I wrote the following code based on what I am guessing you really want, and my idea of that is: match names on 2 sheets in 2 different workbooks, and when a match is found, then copy 5 COLUMNS next to the match in the second workbook into the first one. So if you find a match in 2nd workbook at B33 (name in first WB at B4) then copy C33:G33 from 2nd workbook into C4:G4 of the first one. The various column IDs are definable in the code. Here's that code (note that it prompts you for the second workbook, so that one should not be open when you run the macro). I've tried to keep the lines short so that the system here doesn't mess things up. Check after you copy the code for any red lines in your code, that just means that whatever is red probably should be at the end of the line above it. Sub CopyFrom2ndWorkbook() 'change these Const values as required 'name of the worksheet in this workbook 'to copy data into, is also the sheet 'with the source list of names Const destinationSheetName = "Sheet1" 'first row with names in it Const destSheet1stNameRow = 2 'column with the names in it Const destSheetNamesCol = "B" '1st column to copy information into Const destSheet1stCopyCol = "C" 'last column to copy information into Const destSheetLastCopyCol = "G" 'information about worksheet in the other 'workbook (one that will be opened and copied from) Const sourceSheetName = "2ksPublicAssistance (3)" Const srcSheetNamesCol = "B" 'first row with names in it Const srcSheet1stNameRow = 2 'first column to copy from Const srcSheet1stCopyCol = "C" 'last column to copy from Const srcSheetLastCopyCol = "G" Dim srcWB As Workbook ' will be copy from workbook Dim srcWS As Worksheet ' will be copy from sheet Dim srcNamesList As Range Dim anySrcName As Range Dim srcCopyRange As Range Dim srcWBName As String Dim destWS As Worksheet ' sheet in this workbook Dim destNamesList As Range Dim anyDestName As Range Dim destCopyRange As Range 'prompt user to open the other workbook srcWBName = Application.GetOpenFilename If UCase(Trim(srcWBName)) = "FALSE" Then 'user cancelled the get filename operation Exit Sub End If Application.ScreenUpdating = False 'open w/o updating links and as Read Only Application.DisplayAlerts = False Workbooks.Open srcWBName, False, True Application.DisplayAlerts = True 'opened book becomes active Set srcWB = ActiveWorkbook 'back to this workbook ThisWorkbook.Activate Set srcWS = srcWB.Worksheets(sourceSheetName) Set srcNamesList = srcWS.Range(srcSheetNamesCol & srcSheet1stNameRow _ & ":" & srcWS.Range(srcSheetNamesCol & Rows.Count).End(xlUp).Address) Set destWS = ThisWorkbook.Worksheets(destinationSheetName) Set destNamesList = destWS.Range(destSheetNamesCol & destSheet1stNameRow _ & ":" & destWS.Range(destSheetNamesCol & Rows.Count).End(xlUp).Address) 'note that in VB, case is important: Bill does not = BILL For Each anyDestName In destNamesList For Each anySrcName In srcNamesList If anySrcName = anyDestName Then 'have a match 'NOTE: number of columns in each range must be same 'not their addresses, but total number of columns, as 'C#:G# = 5 columns Set srcCopyRange = srcWS.Range(srcSheet1stCopyCol _ & anySrcName.Row _ & ":" & srcSheetLastCopyCol & anySrcName.Row) Set destCopyRange = destWS.Range(destSheet1stCopyCol & anyDestName.Row _ & ":" & destSheetLastCopyCol & anyDestName.Row) destCopyRange.Value = srcCopyRange.Value 'we can quit now that we found the match Exit For ' exit the anySrcName loop End If Next Next 'housekeeping Set destNamesList = Nothing Set srcNamesList = Nothing Set srcWS = Nothing Set destWS = Nothing 'close the other workbook, do not save changes Application.DisplayAlerts = False srcWB.Close False Application.DisplayAlerts = True Set srcWB = Nothing MsgBox "Copy from:" & vbCrLf & srcWBName & vbCrLf & "Completed", _ vbOKOnly + vbInformation, "Task Finished" End Sub "Tom" wrote: Wow! You are very methodical and it performs exactly what I hope it would do. Thank you very much. I have a slightly similar request. This time getting back some data. Much obliged if you can help with this task as outlined below: Read a list of column names from two open workbooks - MyWorkbook1 in Sheet1, starting from Column2 Row 3, then find the same name in Myworkbook2. Copy a set of 5 row values next to its right, then paste it back in MyWorkbook1 next to the right and stop at the end of the list. Skip if a name is not found. "JLatham" wrote in message ... Tom, In defense of JLGWhiz, you did say "...allows me to update the weekly wages for some of these members by..." And that's what his code does. Had you initially requested code to update them all, I'm certain he would have provided exactly that. I'm certain that he overlooked, as I did, the at-the-end of the post reference to identity numbers on sheet2. So, try this code in a copy of your workbook and see if it does what you want or not. You'll need to change the Const values at the beginning of it after you do the copy to match worksheet names and column IDs in your workbook before running it. Sub UpdateWages() 'alter Const values as needed for your workbook Const wageSheetName = "SheetWithWages" ' sheet1? Const firstWGIDRow = 2 ' first row w/employee id Const wsIDColumn = "A" Const wswagecolumn = "F" Const amtOfRaise = 0.045 ' 4.5% Const updateListSheetName = "RaiseListSheet" ' sheet2? Const lsIDColumn = "A" Dim wgWS As Worksheet Dim wgIdList As Range Dim anywgID As Range Dim lsWS As Worksheet Dim lsIDList As Range Dim anylsID As Range Set wgWS = ThisWorkbook.Worksheets(wageSheetName) Set wgIdList = wgWS.Range(wsIDColumn & firstWGIDRow & ":" _ & wgWS.Range(wsIDColumn & Rows.Count).End(xlUp).Address) Set lsWS = ThisWorkbook.Worksheets(updateListSheetName) Set lsIDList = lsWS.Range(lsIDColumn & ":" & lsIDColumn) For Each anywgID In wgIdList Set anylsID = lsIDList.Find(What:=anywgID, _ LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, _ SearchDirection:=xlNext, MatchCase:=False, _ SearchFormat:=False) If Not anylsID Is Nothing Then 'found a match wgWS.Range(wswagecolumn & anywgID.Row) = _ wgWS.Range(wswagecolumn & anywgID.Row) * (1 + amtOfRaise) End If Next Set wgIdList = Nothing Set lsIDList = Nothing Set wgWS = Nothing Set lsWS = Nothing End Sub . |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
2007 Formula Needed to Update Table Values | Excel Discussion (Misc queries) | |||
Codes needed to copy same one row from more than 300 Excel files | Excel Discussion (Misc queries) | |||
how do i use code39 bar codes that update as a cells value chages | Excel Worksheet Functions | |||
code needed to update links | Excel Programming | |||
re : Help needed on some codes | Excel Programming |