Extract specified data from multiple request forms to another excel workbook

jenovauh

New Member
Joined
Mar 21, 2011
Messages
6
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>
 

Some videos you may like

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).

Watch MrExcel Video

Forum statistics

Threads
1,109,364
Messages
5,528,265
Members
409,811
Latest member
pjwhyman

This Week's Hot Topics

  • Change military grades into rank
    Afternoon all Need help with formula that will change military rank (i.e. 1, 2, 3 into Amn, A1C, SrA). Running IF formula that does not work...
  • VBA COUNTIF SOLUTION
    Hi The following are the errors spread across the several columns from E to Q ie. 13 columns across several sheets with more than 500 rows per...
  • INSERT ROW WITH SPECIFIS TEXT IN A COLUMN
    Hi All! How can identify that that the row to be inserted has to be inserted before 1st row with specific text in column F. If I record the...
  • Auto-Create a monthly Sign in sheet for preschool students
    The image below is what each page looks like. Above is space for the "Child Name" "Month" "Class" School days are obviously Monday-Friday but...
  • VBA vlookup multiple results
    Hi folks, Hopefully someone out there can help. I have a list to vlookup which works (ish). the lookup only picks up the first instance of the...
  • Extract values for earliest/latest times
    I am trying to put together a formula to get the earliest start time, the latest end time from column A for each person in Column B-F without the...
Top