Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
Tom Tom is offline
external usenet poster
 
Posts: 49
Default 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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1,565
Default 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   Report Post  
Posted to microsoft.public.excel.programming
Tom Tom is offline
external usenet poster
 
Posts: 49
Default 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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,203
Default 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   Report Post  
Posted to microsoft.public.excel.programming
Tom Tom is offline
external usenet poster
 
Posts: 49
Default 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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,203
Default 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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,203
Default 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   Report Post  
Posted to microsoft.public.excel.programming
Tom Tom is offline
external usenet poster
 
Posts: 49
Default 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   Report Post  
Posted to microsoft.public.excel.programming
Tom Tom is offline
external usenet poster
 
Posts: 49
Default 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
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
2007 Formula Needed to Update Table Values Flintstone[_2_] Excel Discussion (Misc queries) 8 February 23rd 10 09:24 PM
Codes needed to copy same one row from more than 300 Excel files Joe Roberto Excel Discussion (Misc queries) 1 September 25th 09 12:07 PM
how do i use code39 bar codes that update as a cells value chages woody Excel Worksheet Functions 1 April 3rd 07 09:46 PM
code needed to update links David Excel Programming 0 September 8th 06 10:02 PM
re : Help needed on some codes dic09 Excel Programming 0 July 11th 06 06:26 AM


All times are GMT +1. The time now is 08:50 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"