简体   繁体   中英

Excel VBA - Creating New Spreadsheet With Only New Information and Changes Highlighted

My goal: I need to be able to take two different worksheets from different workbooks and combine them into one workbooks with two worksheets (already completed). One of the worksheets will be from older data and be used as a masterlist, while the other worksheet will contain the older data along with new data (and changes to old data). I need to be able to get rid of the old data already on the masterlist but still check to see if there is any changes in the older data (the information will be deleted from the new information worksheet). The end goal is to have two worksheets: 1 contains the old information (already done) and 1 contains the new information and any changes to the new information (need help with).

What I have now:

Sub DocumentInspector()

Dim RowCount As Integer
Dim Row As Integer
Dim Column As Integer
Dim ColumnCount As Integer
Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim MyPath As String
Dim strFilename As String
Dim i As Integer
Dim count As Integer
Dim count2 As Integer

count2 = 0
i = 0
count = 0

Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False

MyPath = "F:\ \Document Inspector" ' change to suit

Set wbDst = Workbooks("DocumentInspector.xlsm")
strFilename = Dir(MyPath & "\*.xlsx", vbNormal)
If Len(strFilename) = 0 Then Exit Sub

Do Until strFilename = ""
        Set wbSrc = Workbooks.Open(Filename:=MyPath & "\" & strFilename)
        Set wsSrc = wbSrc.Worksheets(1)
        wsSrc.Copy After:=wbDst.Worksheets(wbDst.Worksheets.count)
        strFilename = Dir()
Loop

wbDst.Worksheets(2).Name = "Old Information"
wbDst.Worksheets(3).Name = "New Information"

'MUST CHANGE RANGES
RowCount = Sheets("New Information").UsedRange.Rows.count
ColumnCount = Sheets("New Information").UsedRange.Columns.count
'MUST CHANGE RANGE
For Each x In Sheets("Old Information").Range("A1:E10")

    For Row = 2 To RowCount
        For Column = 1 To ColumnCount
            If x.Value = Sheets("New Information").Cells(Row, Column).Value Then
                    Sheets("New Information").Cells(Row, Column).Interior.Color = RGB(255, 255, 0)
            End If
        Next Column
    Next Row
Next

For Row = 2 To RowCount
    For Column = 1 To ColumnCount

        If Sheets("New Information").Cells(Row, Column).Interior.Color = RGB(255, 255, 0) Then
            Sheets("New Information").Cells(Row, Column).Interior.Color = xlNone
            count = count + 1
        Else
            Sheets("New Information").Cells(Row, Column).Interior.Color = RGB(255, 255, 0)
            count2 = count2 + 1
        End If
     Next Column

    If count = ColumnCount Then
        Sheets("New Information").Rows(Row).EntireRow.Interior.Color = xlNone
        Sheets("New Information").Rows(Row).EntireRow.Delete
        Row = Row - 1
    ElseIf count2 = ColumnCount Then
        Sheets("New Information").Rows(Row).EntireRow.Interior.Color = xlNone
        Sheets("New Information").Rows(Row).EntireRow.Delete
    End If
    count2 = 0
    count = 0
Next Row


Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Try this,
I have done with formulas, you can do the same in VBA too dynamically.

It can be one solution but there may be better than this.

refer the image below.

It is simple match and concatenate. 图片

Example of what I need to be able to do:

Worksheet 1 "Old Information"

ABCD

EFGH

Worksheet 2 "New Information"

ABCD

EFJH

Runs Code....

Worksheet 1 "Old Information"

ABCD

EFGH

Worksheet 2 "New Information"

EFJH (with J highlighted)

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM