Update data from one sheet to another need an addition.

bsharath
bsharath used Ask the Experts™
on
Hi,

Update data from one sheet to another need an addition.

below code just works fine but want Colum "BH" from desktops to be updated in Colum 'G" in this sheet.
And
in Colum A,B,C,D,E,F,G in Row 1 i want these headers placed and made bold
Full No,Extension,Seat No,Emp ID,Name,Email,Project Manager

Can anyone please help on this.

regards
sharath
Public Sub Script_STD()
Dim lookupArray(4) As Integer
Dim lookupSheet As String
Dim startR As Integer
Dim startC As String
Dim matchRange As Range
Dim curCell As Range
Dim lookupRange As Range
Dim curSht As String
 
'Set the sheet calling the function
curSht = ActiveWorkbook.ActiveSheet.Name
 
'Edit these to be the first row of the column you want to match from the STD&ISD sheet
startC = "B"
startR = 2
 
'Edit this to be the name of the sheet you want to grab data from
lookupSheet = "Desktops"
 
'Edit this array to be the columns you want to grab from the Desktops sheet
'If you want a different # of columns than 4, edit the Dim statement as well accordingly
lookupArray(1) = 2 'Column B
lookupArray(2) = 5 'Column E
lookupArray(3) = 11 'Column K
lookupArray(4) = 15 'Column O
 
'Define the lookup table
Set lookupRange = Range(Sheets(lookupSheet).Range("A2"), Sheets(lookupSheet).Range(Cells(Sheets(lookupSheet).Range("D65536").End(xlUp).row, Sheets(lookupSheet).Range("IV1").End(xlToLeft).Column).Address))
Sheets(curSht).Select
Set matchRange = ActiveSheet.Range(startC & startR, Range(startC & 65536).End(xlUp).Address)
For Each curCell In matchRange
 'Check to see if there is a match.  If not, highlight the row and delete any data.  If there is, fill in the data
 If IsError(Application.Match(curCell.Value, Sheets(lookupSheet).Range("D2", Sheets(lookupSheet).Range("D65536").End(xlUp).Address), 0)) Then
  'No match
  curCell.Cells.Interior.ColorIndex = 36
  curCell.Cells.Interior.Pattern = xlSolid
  Range(curCell.Offset(0, 1), curCell.Offset(0, UBound(lookupArray))).Value = ""
 Else
  'There is a match, so fill in data accordingly
  For i = 1 To UBound(lookupArray)
    curCell.Cells.Interior.ColorIndex = xlNone
    curCell.Offset(0, i).Value = Application.Index(Sheets(lookupSheet).Range(lookupRange.Address), Application.Match(curCell.Value, Sheets(lookupSheet).Range("D2", Sheets(lookupSheet).Range("D65536").End(xlUp).Address), 0), lookupArray(i))
  Next i
 End If
Next curCell
 
End Sub

Open in new window

Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Commented:
To add another column it looks like all you need to do is modify Dim lookupArray(4) as integer to have another value... for the example you gave, I would go with Dim LookupArray(5) and then change

Edit this array to be the columns you want to grab from the Desktops sheet
'If you want a different # of columns than 4, edit the Dim statement as well accordingly
lookupArray(1) = 2 'Column B
lookupArray(2) = 5 'Column E
lookupArray(3) = 11 'Column K
lookupArray(4) = 15 'Column O

to add

lookuparray(5) = xx substituting the column number for BH for xx (which I believe is 60)

this should allow you to include that cell information on the main sheet, but you may need to add additional lookuparray elements to get to column G, as column G is column 7.

I am still looking at the header item mentioned above.  I know it can be done, but I am not quite sure how.

Author

Commented:
ok thanks

Author

Commented:
Any views...

Author

Commented:
Any views...

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial