Word Document Data to Excel Spreadsheet code/macro

[junglej815]

Hello All,

I would like to first thank the people who help out all of us others who are seeking help on here. I'm hoping someone can assist with what I'm looking for help on, which there might be a better way to do this anyways.

I'm basically looking for a way to keep track of what days people offer to pick up for Overtime. To have some type of word document form that each individual would fill out and submit. I would like to have an Excel Spreadsheet that would have each day of the month ( possibly a column for each day ) on it and then run a macro that would put each individual's names, number of hours they'd work, and the shift in the column for the day that they would be willing to work.

I've done some testing where I have the grey boxes ( ActiveX boxes??) ;and the text entered in those get inserted into Excel by use of the following code that I did find on here:


Sub GetFormData()
'Note: this code requires a reference to the Word object model
Application.ScreenUpdating = False
Dim wdApp As New Word.Application
Dim wdDoc As Word.Document
Dim FmFld As Word.FormField
Dim strFolder As String, strFile As String
Dim WkSht As Worksheet, i As Long, j As Long
strFolder = GetFolder
If strFolder = "" Then Exit Sub
Set WkSht = ActiveSheet
i = WkSht.Cells(WkSht.Rows.Count, 1).End(xlUp).Row
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
i = i + 1
Set wdDoc = wdApp.Documents.Open(Filename:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
With wdDoc
j = 0
For Each FmFld In .FormFields
j = j + 1
WkSht.Cells(i, j) = FmFld.Result
Next
End With
wdDoc.Close SaveChanges:=False
strFile = Dir()
Wend
wdApp.Quit
Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht = Nothing
Application.ScreenUpdating = True
End Sub

Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function




The code works by inserting the information provided on the word document into each column in Excel, I just don't know how I could possibly get it so that the names are automatically put into the column that would correspond to the date provided on the word form. It also goes off by selecting the information that is saved in a particular folder and this would be something that keeps getting new names added to it/each day, so if I keep each document in that particular folder every time I run the macro I just keep re-adding the same info. Which I suppose After it would get added to the spreadsheet the form could just be deleted. Maybe this could all be done an easier/better way and I just don't know.

I hope this makes sense and appreciate any help you guys have to offer.

[mana]

RemoveDuplicates Method ?

[junglej815]

Thanks for responding mana.......I have to say I don't know what the refers to though.....

[mana]

Option Explicit


Sub test()
Dim WkSht As Worksheet
Dim col

Set WkSht = ActiveSheet

With WkSht.Cells(1).CurrentRegion
col = Evaluate("transpose(row(1:" & .Columns.Count & "))")
ReDim Preserve col(0 To UBound(col) - 1)
.RemoveDuplicates Columns:=CVar(col), Header:=xlYes
End With

End Sub

[mana]

remove duplicate values (https://support.office.com/en-us/article/Filter-for-unique-values-or-remove-duplicate-values-ccf664b0-81d6-449b-bbe1-8daaec1e83c2?ui=en-US&rs=en-US&ad=US&fromAR=1)