Hi All ,
I have 2 spreadsheets. I need to pull gross salary info from one to another by clicking a refresh button. I thought I could use employee reference no as an unique number to match the records and pull gross salary regularly. Do we have a code for this I could use by changing necessary bits?
Cheers
Yeliz
Sub Learning VBA()
Do
Practice Most Useful VBA Examples
Loop Until Become an Expert in VBA
End Sub
I've found below code to use Vlookup function in VBA to pull gross salary from one workbook to another by using employeeID. However I'm not sure which bits I need to change to apply it on my workbooks(attached). Can anyone tell me which parts I need to change in below code?
[VBA]Sub TestLookup()
Dim FileName As String
FileName = "C:\yeliz\gross salary.xls"
adoLookup FileName, ActiveSheet.Cells(2, 1)
End Sub
Sub adoLookup(FileName As String, luValue As String)
Dim adoRs As New ADODB.Recordset
Dim adoConn As New ADODB.Connection
Dim query As String
Dim col As Integer
With adoConn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source=" & FileName & ";Extended Properties=Excel 8.0;"
.Open
End With
query = "SELECT * FROM [Sheet1$A16000]"
With adoRs
.CursorLocation = adUseClient
.Open query, adoConn, adOpenStatic, adLockReadOnly, adCmdText
.Fields(0).Properties("Optimize") = True
.Find "EmployeeID = '" & luValue & "'"
If Not .EOF Then
For col = 1 To 3
ActiveSheet.Cells(5, col + 1) = .Fields(col)
Next
Else
MsgBox "Employee " & luValue & " could not be found.", vbOKOnly, "Invalid ID"
End If
End With
End Sub[/VBA]
Sub Learning VBA()
Do
Practice Most Useful VBA Examples
Loop Until Become an Expert in VBA
End Sub
Hi there,
A bit rough, but hopefully enough to get you started.
In a Standard Module:
[VBA]
Option Explicit
Sub Example()
Dim wbPayroll As Workbook
Dim wksSource As Worksheet
Dim wksDest As Worksheet
Dim Cell As Range
Dim rngSource As Range
Dim rngDest As Range
Dim lLRow As Long
'// Attempt to set references to the destination wb and the source/dest sheets. //
On Error Resume Next
Set wbPayroll = Workbooks("payroll.xls")
Set wksDest = wbPayroll.Worksheets(".csv)50s.payroll(1)")
Set wksSource = ThisWorkbook.Worksheets(".csv)50s.payroll(1)")
On Error GoTo 0
'// If any fail, bail. //
If wbPayroll Is Nothing Or wksSource Is Nothing Or wksDest Is Nothing Then
GenericError
Exit Sub
End If
'// Similarly, make sure we have data or get out. //
Set Cell = RangeFound(wksSource.Cells)
If Not Cell Is Nothing Then
If Not Cell.Row > 2 Then
GenericError
Exit Sub
End If
Else
GenericError
Exit Sub
End If
Set rngSource = wksSource.Range(wksSource.Cells(2, 1), wksSource.Cells(Cell.Row, 7))
Set Cell = Nothing
Set Cell = RangeFound(wksDest.Cells)
If Not Cell Is Nothing Then
If Not Cell.Row > 2 Then
GenericError
Exit Sub
End If
Else
GenericError
Exit Sub
End If
Set rngDest = wksDest.Range(wksDest.Cells(2, 1), wksDest.Cells(Cell.Row, 4))
'// Run down the first column of source worksheet, using MATCH to see if we find the//
'// employee's ID in the destination sheet. //
For Each Cell In rngSource.Columns(1).Cells
If Not IsError(Application.Match(Cell.Value, rngDest.Columns(1).Cells, 0)) Then
rngDest.Cells(Application.Match(Cell.Value, rngDest.Columns(1).Cells, 0), 4).Value = Cell.Offset(, 6).Value
End If
Next
End Sub
Sub GenericError()
MsgBox "You must have ""payroll.xls"" open, " & _
"both source and destination sheets must exist," & vbCrLf & _
"and there must be data on each sheet.", 0, ""
End Sub
Function RangeFound(SearchRange As Range, _
Optional ByVal FindWhat As String = "*", _
Optional StartingAfter As Range, _
Optional LookAtTextOrFormula As XlFindLookIn = xlValues, _
Optional LookAtWholeOrPart As XlLookAt = xlPart, _
Optional SearchRowCol As XlSearchOrder = xlByRows, _
Optional SearchUpDn As XlSearchDirection = xlPrevious, _
Optional bMatchCase As Boolean = False) As Range
If StartingAfter Is Nothing Then
Set StartingAfter = SearchRange(1)
End If
Set RangeFound = SearchRange.Find(What:=FindWhat, _
After:=StartingAfter, _
LookIn:=LookAtTextOrFormula, _
LookAt:=LookAtWholeOrPart, _
SearchOrder:=SearchRowCol, _
SearchDirection:=SearchUpDn, _
MatchCase:=bMatchCase)
End Function
[/VBA]
Hope that helps,
Mark
Sorry, the above would go in "gross salary.xls"
Hi Mark!!
Thank you so much for your help and time..It's much appreciated..I love technology it makes life a lot easier..This is like a magic that's why I have to learn VBA..well I started to study at least..
I am going to use it in original file so I'll change file names in code.
Thanks again..
Yeliz
Sub Learning VBA()
Do
Practice Most Useful VBA Examples
Loop Until Become an Expert in VBA
End Sub
Yeliz,
It sounds to me like you need a simple Vlookup function. As far as I can understand, you are trying to pull the G-column data on the Gross Salary.xls file to D-Column on the Payroll.xls file as long as the Employee ID matches.
This can be done by a simple formula instead of VBA code. Copy the formula below and paste it to D2 on Payroll.xls workbook. Then fill the formula down to the last row.
Turkish:
=EĞER(EHATALIYSA(DÜŞEYARA($A:$A;'[gross salary .xls].csv)50s.payroll(1)'!$A:$G;7;0));"";DÜŞEYARA($A:$A;'[gross salary .xls].csv)50s.payroll(1)'!$A:$G;7;0))
English:
=IF(ISERROR(VLOOKUP($A:$A,'[gross salary .xls].csv)50s.payroll(1)'!$A:$G,7,0)),"",VLOOKUP($A:$A,'[gross salary .xls].csv)50s.payroll(1)'!$A:$G,7,0))
I hope I didn't underestimated your question...
Thanks for your reply Capungo..
Yes, I could use Vlookup function but the structure should be dynamic..whenever users add more records they should press refresh button and database should be updated automatically as users don't know how to set or extend the formulas..That's why I was looking for some code to use Vlookup in VBA - that's difficult though :o) however below code posted by Mark is working perfect..
Cheers
Yeliz
Originally Posted by Capungo
Sub Learning VBA()
Do
Practice Most Useful VBA Examples
Loop Until Become an Expert in VBA
End Sub
You are welcome and I am sorry if I misspent your time...
Posting Permissions
Reply With Quote
