Windows 7: Populating Master Spreadsheet w/o Access

Hey everyone,

I've got kind of a tricky one here. I need to have client information from three separate excel spreadsheet, auto populate a master list. I don't have the option of using access, so I'm left trying to use macros and visual basic programming.

The issue is really the sort and filter functions. I can bring the data from all three sources, and each client has a unique ID code. But replacing duplicate records and merging the rows from different spreadsheets is proving difficult.

Does anyone have any suggestions of an alternate way to achieve this? Or even some tips on the excel functions I should be using? Anything is appreciated.

There could be some useful information here:
Top ten ways to clean your data - Excel - Office.com

Filter for unique values or remove duplicate values - Excel - Office.com

Ya, I'm aware of the filter sort functions. The real issue had to do with automating the procedure across three spreadsheets and three separate users over an intranet server.

I ended up getting some help from a guy over at excelforum. He worked with me to write some visual basic macros that are working pretty well. We still have a couple of kinks to work out, but I can post the basic code once it's up and running, in case anyone else has a similar problem.

Thank you for posting back, mjm6783. I am sure that others with the same problem would be very grateful for sharing your information.

So this is the MAIN section of code which is copied, (although altered slightly) for each of the workbooks which populate the master. It's set up for my specific needs in terms of specific column transfers and sorting/overwriting. There is some minor additional code, but it's unrelated to the functions shown here. Hope this helps someone out there.

Sub RunMe()
Dim wbTarget As Workbook
Dim wbSource As Workbook
Dim MyPath As String
Dim sLR As Long
Dim tLR As Long
Dim sCell As Range
Dim findMe As Range
Dim i As Long
MyPath = ActiveWorkbook.Path
Set wbSource = ThisWorkbook

On Error Resume Next
Set wbTarget = Workbooks("Master.xlsx")
If wbTarget Is Nothing Then 'Not Open
Application.Workbooks.Open (MyPath & "\" & "Master.xlsx")
On Error GoTo 0
Set wbTarget = Workbooks("Master.xlsx")
Else
End If
With wbTarget.Sheets("Sheet1")
tLR = .Range("A" & .Rows.Count).End(xlUp).Row + 1
End With

For i = 1 To wbSource.Sheets.Count
With wbSource.Sheets(i)
sLR = .Range("A" & .Rows.Count).End(xlUp).Row
If sLR <= 1 Then GoTo skip
End With
For Each sCell In wbSource.Sheets(i).Range("B2:B" & sLR)
If Not wbSource.Sheets(i).Range("Z" & sCell.Row) = "X" Then
Set findMe = wbTarget.Sheets("Sheet1").Range("B2:B" & tLR).Find(What:=sCell, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
MatchCase:=False)

If findMe Is Nothing Then
wbTarget.Sheets("Sheet1").Range("B" & tLR).Value = sCell.Value
wbTarget.Sheets("Sheet1").Range("A" & tLR).Value = sCell.Offset(0, -1).Value
wbTarget.Sheets("Sheet1").Range("A" & tLR).Offset(0, 5).Value = sCell.Offset(0, 1).Value
wbTarget.Sheets("Sheet1").Range("A" & tLR).Offset(0, 6).Value = sCell.Offset(0, 2).Value
wbTarget.Sheets("Sheet1").Range("A" & tLR).Offset(0, 7).Value = sCell.Offset(0, 3).Value
wbTarget.Sheets("Sheet1").Range("A" & tLR).Offset(0, 8).Value = sCell.Offset(0, 4).Value
wbTarget.Sheets("Sheet1").Range("A" & tLR).Offset(0, 9).Value = sCell.Offset(0, 5).Value
wbTarget.Sheets("Sheet1").Range("A" & tLR).Offset(0, 10).Value = sCell.Offset(0, 6).Value
tLR = wbTarget.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
wbSource.Sheets(i).Range("Z" & sCell.Row) = "X"
Else
wbTarget.Sheets("Sheet1").Range("B" & findMe.Row).Value = sCell.Value
wbTarget.Sheets("Sheet1").Range("A" & findMe.Row).Value = sCell.Offset(0, -1).Value
wbTarget.Sheets("Sheet1").Range("A" & findMe.Row).Offset(0, 5).Value = sCell.Offset(0, 1).Value
wbTarget.Sheets("Sheet1").Range("A" & findMe.Row).Offset(0, 6).Value = sCell.Offset(0, 2).Value
wbTarget.Sheets("Sheet1").Range("A" & findMe.Row).Offset(0, 7).Value = sCell.Offset(0, 3).Value
wbTarget.Sheets("Sheet1").Range("A" & findMe.Row).Offset(0, 8).Value = sCell.Offset(0, 4).Value
wbTarget.Sheets("Sheet1").Range("A" & findMe.Row).Offset(0, 9).Value = sCell.Offset(0, 5).Value
wbTarget.Sheets("Sheet1").Range("A" & findMe.Row).Offset(0, 10).Value = sCell.Offset(0, 6).Value
tLR = wbTarget.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
wbSource.Sheets(i).Range("Z" & sCell.Row) = "X"
End If
End If
Next sCell

skip:
Next i

Application.ScreenUpdating = False
With wbTarget.Sheets("Sheet1")
tLR = .Cells.Find("*", .Cells(Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=.Range("A2:A" & tLR), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
End With
With wbTarget.Sheets("Sheet1").Sort
.SetRange Range("A1:K" & tLR)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.ScreenUpdating = True

Flag = True
wbTarget.Close True
Set wbTarget = Nothing
Set wbSource = Nothing

End Sub