Hi everyone, I am new with vbs and trying to seek help from the expert here.
I have lots of request forms data to be extracted from a specified folder (c:\Data\) into a new workbook (c:\Data\Complete\Data.xls).
Been working on it for the passed 2 week and still didnt manage to get the result i wanted.
Result that i am trying to achieve:
1: To extract specify data from specified folder which contains all the request excel forms into 1 workbook.
2: Error checking when specify data is empty and will append as "Blank" in the table.
3: To ensure new data will not be overwrite when extracting new data into table.
Below is the code i have been working on, hope that someone can enlighten me. Thanks everyone.
Code:
Sub test()
Dim xRng As Range, yRng As Range
Dim arrLog As Variant
Dim iRow As Long
Dim i As Long
Dim ws As Worksheet
Set ws = Worksheets("Wrong")
Application.ScreenUpdating = False
With Sheets("Form")
arrLog = Array("Staff ID", "Staff Name", "Join Date", "End Date", _
"Contact No", "Email Address", "Grade", "Position Title", _
"Entity", "Work Location", "Cost Centre Code", "*Fixed Salary*", _
"*Basic Salary*", "*Term of Offer*", "*Accomodation and others*")
'Find first empty row in database
iRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
For i = LBound(arrLog) To UBound(arrLog)
Set xRng = .Range("A1:J34").Find(What:=arrLog(i), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Set xRng = Application.Intersect(xRng.Offset(0, 1), xRng.Parent.UsedRange)
'j for number of field to fill in to table database (Sheet2)
For j = 1 To 15
Set yRng = ws.Cells(Rows.Count, j).End(xlUp)
Set yRng = Range(yRng, yRng.Cells(1, xRng.Columns.Count))
yRng.Value = xRng.Value
'MsgBox arrLog(I) & " : " & xRng
'ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row.Paste
Next j
Next i
If Nothing Is xRng Then MsgBox "Nothing Found": Exit Sub
End With
Application.ScreenUpdating = True
End Sub
Table in another workbook:
<table border="0" cellpadding="0" cellspacing="0" width="960"><col span="15" width="64"><tbody><tr height="20"> <td class="xl73" style="height: 15pt; width: 48pt; font-size: 11pt; color: white; font-weight: 700; text-decoration: none; font-family: Calibri; border: 0.5pt solid windowtext; background: none repeat scroll 0% 0% rgb(75, 172, 198);" height="20" width="64">Staff ID</td> <td class="xl73" style="width: 48pt; font-size: 11pt; color: white; font-weight: 700; text-decoration: none; font-family: Calibri; border: 0.5pt solid windowtext; background: none repeat scroll 0% 0% rgb(75, 172, 198);" width="64">Staff Name </td> <td class="xl73" style="width: 48pt; font-size: 11pt; color: white; font-weight: 700; text-decoration: none; font-family: Calibri; border: 0.5pt solid windowtext; background: none repeat scroll 0% 0% rgb(75, 172, 198);" width="64">Join Date</td> <td class="xl73" style="width: 48pt; font-size: 11pt; color: white; font-weight: 700; text-decoration: none; font-family: Calibri; border: 0.5pt solid windowtext; background: none repeat scroll 0% 0% rgb(75, 172, 198);" width="64">End Date</td> <td class="xl73" style="width: 48pt; font-size: 11pt; color: white; font-weight: 700; text-decoration: none; font-family: Calibri; border: 0.5pt solid windowtext; background: none repeat scroll 0% 0% rgb(75, 172, 198);" width="64">Contact No</td> <td class="xl73" style="width: 48pt; font-size: 11pt; color: white; font-weight: 700; text-decoration: none; font-family: Calibri; border: 0.5pt solid windowtext; background: none repeat scroll 0% 0% rgb(75, 172, 198);" width="64">Email Address</td> <td class="xl73" style="width: 48pt; font-size: 11pt; color: white; font-weight: 700; text-decoration: none; font-family: Calibri; border: 0.5pt solid windowtext; background: none repeat scroll 0% 0% rgb(75, 172, 198);" width="64">Grade</td> <td class="xl73" style="width: 48pt; font-size: 11pt; color: white; font-weight: 700; text-decoration: none; font-family: Calibri; border: 0.5pt solid windowtext; background: none repeat scroll 0% 0% rgb(75, 172, 198);" width="64">Position Title</td> <td class="xl73" style="width: 48pt; font-size: 11pt; color: white; font-weight: 700; text-decoration: none; font-family: Calibri; border: 0.5pt solid windowtext; background: none repeat scroll 0% 0% rgb(75, 172, 198);" width="64">Entity</td> <td class="xl73" style="width: 48pt; font-size: 11pt; color: white; font-weight: 700; text-decoration: none; font-family: Calibri; border: 0.5pt solid windowtext; background: none repeat scroll 0% 0% rgb(75, 172, 198);" width="64">Work Location</td> <td class="xl73" style="width: 48pt; font-size: 11pt; color: white; font-weight: 700; text-decoration: none; font-family: Calibri; border: 0.5pt solid windowtext; background: none repeat scroll 0% 0% rgb(75, 172, 198);" width="64">Cost Centre Code</td> <td class="xl73" style="width: 48pt; font-size: 11pt; color: white; font-weight: 700; text-decoration: none; font-family: Calibri; border: 0.5pt solid windowtext; background: none repeat scroll 0% 0% rgb(75, 172, 198);" width="64">Fixed Salary</td> <td class="xl73" style="width: 48pt; font-size: 11pt; color: white; font-weight: 700; text-decoration: none; font-family: Calibri; border: 0.5pt solid windowtext; background: none repeat scroll 0% 0% rgb(75, 172, 198);" width="64">Basic Salary</td> <td class="xl73" style="width: 48pt; font-size: 11pt; color: white; font-weight: 700; text-decoration: none; font-family: Calibri; border: 0.5pt solid windowtext; background: none repeat scroll 0% 0% rgb(75, 172, 198);" width="64">Term of Offer</td> <td class="xl73" style="width: 48pt; font-size: 11pt; color: white; font-weight: 700; text-decoration: none; font-family: Calibri; border: 0.5pt solid windowtext; background: none repeat scroll 0% 0% rgb(75, 172, 198);" width="64">ACCOMODATION AND OTHERS</td> </tr></tbody></table>
I have lots of request forms data to be extracted from a specified folder (c:\Data\) into a new workbook (c:\Data\Complete\Data.xls).
Been working on it for the passed 2 week and still didnt manage to get the result i wanted.
Result that i am trying to achieve:
1: To extract specify data from specified folder which contains all the request excel forms into 1 workbook.
2: Error checking when specify data is empty and will append as "Blank" in the table.
3: To ensure new data will not be overwrite when extracting new data into table.
Below is the code i have been working on, hope that someone can enlighten me. Thanks everyone.
Code:
Sub test()
Dim xRng As Range, yRng As Range
Dim arrLog As Variant
Dim iRow As Long
Dim i As Long
Dim ws As Worksheet
Set ws = Worksheets("Wrong")
Application.ScreenUpdating = False
With Sheets("Form")
arrLog = Array("Staff ID", "Staff Name", "Join Date", "End Date", _
"Contact No", "Email Address", "Grade", "Position Title", _
"Entity", "Work Location", "Cost Centre Code", "*Fixed Salary*", _
"*Basic Salary*", "*Term of Offer*", "*Accomodation and others*")
'Find first empty row in database
iRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
For i = LBound(arrLog) To UBound(arrLog)
Set xRng = .Range("A1:J34").Find(What:=arrLog(i), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Set xRng = Application.Intersect(xRng.Offset(0, 1), xRng.Parent.UsedRange)
'j for number of field to fill in to table database (Sheet2)
For j = 1 To 15
Set yRng = ws.Cells(Rows.Count, j).End(xlUp)
Set yRng = Range(yRng, yRng.Cells(1, xRng.Columns.Count))
yRng.Value = xRng.Value
'MsgBox arrLog(I) & " : " & xRng
'ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row.Paste
Next j
Next i
If Nothing Is xRng Then MsgBox "Nothing Found": Exit Sub
End With
Application.ScreenUpdating = True
End Sub
Table in another workbook:
<table border="0" cellpadding="0" cellspacing="0" width="960"><col span="15" width="64"><tbody><tr height="20"> <td class="xl73" style="height: 15pt; width: 48pt; font-size: 11pt; color: white; font-weight: 700; text-decoration: none; font-family: Calibri; border: 0.5pt solid windowtext; background: none repeat scroll 0% 0% rgb(75, 172, 198);" height="20" width="64">Staff ID</td> <td class="xl73" style="width: 48pt; font-size: 11pt; color: white; font-weight: 700; text-decoration: none; font-family: Calibri; border: 0.5pt solid windowtext; background: none repeat scroll 0% 0% rgb(75, 172, 198);" width="64">Staff Name </td> <td class="xl73" style="width: 48pt; font-size: 11pt; color: white; font-weight: 700; text-decoration: none; font-family: Calibri; border: 0.5pt solid windowtext; background: none repeat scroll 0% 0% rgb(75, 172, 198);" width="64">Join Date</td> <td class="xl73" style="width: 48pt; font-size: 11pt; color: white; font-weight: 700; text-decoration: none; font-family: Calibri; border: 0.5pt solid windowtext; background: none repeat scroll 0% 0% rgb(75, 172, 198);" width="64">End Date</td> <td class="xl73" style="width: 48pt; font-size: 11pt; color: white; font-weight: 700; text-decoration: none; font-family: Calibri; border: 0.5pt solid windowtext; background: none repeat scroll 0% 0% rgb(75, 172, 198);" width="64">Contact No</td> <td class="xl73" style="width: 48pt; font-size: 11pt; color: white; font-weight: 700; text-decoration: none; font-family: Calibri; border: 0.5pt solid windowtext; background: none repeat scroll 0% 0% rgb(75, 172, 198);" width="64">Email Address</td> <td class="xl73" style="width: 48pt; font-size: 11pt; color: white; font-weight: 700; text-decoration: none; font-family: Calibri; border: 0.5pt solid windowtext; background: none repeat scroll 0% 0% rgb(75, 172, 198);" width="64">Grade</td> <td class="xl73" style="width: 48pt; font-size: 11pt; color: white; font-weight: 700; text-decoration: none; font-family: Calibri; border: 0.5pt solid windowtext; background: none repeat scroll 0% 0% rgb(75, 172, 198);" width="64">Position Title</td> <td class="xl73" style="width: 48pt; font-size: 11pt; color: white; font-weight: 700; text-decoration: none; font-family: Calibri; border: 0.5pt solid windowtext; background: none repeat scroll 0% 0% rgb(75, 172, 198);" width="64">Entity</td> <td class="xl73" style="width: 48pt; font-size: 11pt; color: white; font-weight: 700; text-decoration: none; font-family: Calibri; border: 0.5pt solid windowtext; background: none repeat scroll 0% 0% rgb(75, 172, 198);" width="64">Work Location</td> <td class="xl73" style="width: 48pt; font-size: 11pt; color: white; font-weight: 700; text-decoration: none; font-family: Calibri; border: 0.5pt solid windowtext; background: none repeat scroll 0% 0% rgb(75, 172, 198);" width="64">Cost Centre Code</td> <td class="xl73" style="width: 48pt; font-size: 11pt; color: white; font-weight: 700; text-decoration: none; font-family: Calibri; border: 0.5pt solid windowtext; background: none repeat scroll 0% 0% rgb(75, 172, 198);" width="64">Fixed Salary</td> <td class="xl73" style="width: 48pt; font-size: 11pt; color: white; font-weight: 700; text-decoration: none; font-family: Calibri; border: 0.5pt solid windowtext; background: none repeat scroll 0% 0% rgb(75, 172, 198);" width="64">Basic Salary</td> <td class="xl73" style="width: 48pt; font-size: 11pt; color: white; font-weight: 700; text-decoration: none; font-family: Calibri; border: 0.5pt solid windowtext; background: none repeat scroll 0% 0% rgb(75, 172, 198);" width="64">Term of Offer</td> <td class="xl73" style="width: 48pt; font-size: 11pt; color: white; font-weight: 700; text-decoration: none; font-family: Calibri; border: 0.5pt solid windowtext; background: none repeat scroll 0% 0% rgb(75, 172, 198);" width="64">ACCOMODATION AND OTHERS</td> </tr></tbody></table>
