Monday, July 21, 2008

Combining 2 database from excel worksheets by using VBA

My work involved analysis of numerous data and these data are located in several different databases of Excel worksheets.

So, the first step would be the integration of these data into one single worksheet.

I have been pondering a technique - using autofilter for a few days and developed a few modules leading to my objectives.

As at yesterday, I got the module right for my desired objective. The codes in the module are customised to my sample databases. Application on other database needs some modification. If you need the advise, please do not hesistate to email me.

BTW, for sharing purpose, codes are written as below:-

Sub CopywithAutoFilterToExistingSheet()

Dim WS4 As Worksheet
Dim WS5 As Worksheet
Dim WSFiltered As Worksheet

Dim FilterRange As Range, Range1 As Range, Range2 As Range

Dim NextColumn As Long
Dim x As Long


Set WS4 = Worksheets("sheet4")
Set WS5 = Worksheets("sheet5")

Set FilterRange = WS4.Range("A1:C" & Rows.Count)

WS4.AutoFilterMode = False
WS5.AutoFilterMode = False


For x = 1 To 1

NextColumn = Cells(x, Columns.Count).End(xlToLeft).Column + 1

FilterRange.AutoFilter Field:=1, Criteria1:="=" & WS5.Cells(x + 1, 1).Value
FilterRange.AutoFilter Field:=2, Criteria1:="=" & WS5.Cells(x + 1, 2).Value

WS4.AutoFilter.Range.Copy
With Workbooks("TestEnteringValueAtNextEmptyCellColumn.xlsm").Sheets("Sheet5").Cells(x, NextColumn)
.PasteSpecial xlPasteValues

End With

WS4.AutoFilterMode = False

Next



For x = 2 To 10

NextColumn = Cells(x, Columns.Count).End(xlToLeft).Column + 1

FilterRange.AutoFilter Field:=1, Criteria1:="=" & WS5.Cells(x + 1, 1).Value
FilterRange.AutoFilter Field:=2, Criteria1:="=" & WS5.Cells(x + 1, 2).Value

WS4.AutoFilter.Range.Copy
With Workbooks("TestEnteringValueAtNextEmptyCellColumn.xlsm").Sheets("Sheet5").Cells(x + 1, NextColumn - 3)
.PasteSpecial xlPasteValues

Cells(x + 2, 4).Cut Cells(x + 1, 4)
Cells(x + 2, 5).Cut Cells(x + 1, 5)
Cells(x + 2, 6).Cut Cells(x + 1, 6)

End With


WS4.AutoFilterMode = False

Next


End Sub




0 comments: