'Merging' with condidtions

gjgj · Jan 10, 2011

Hi all,
sorry if this was covered already but I couldn't find a thread that matches my problem.

Basically I have two documents, they are both the same file basically, but one is an update on the other.
The info inside is a list of values (usually text but sometimes is numbers - a string table for a piece of software using text if you're interested).
Each cell with a piece of valuable data is catalogued with a reference name or number (an ID).
The layout is very simple:
The ID is in Col A, and the data is in B. So it might look like:
ID | Data
1a | John
2b | Clare
3c | Stephen

What I do is update the data in Col.B for any errors, then highlight the cell in a colour. Problem is that midway through this job I get an updated file with new lines and I have to merge the data to the correct place in the new file.
So for eg. , lets say I edited line 2b in file 1 from the above to:
ID | Data
1a | John
2b | Clairé
3c | Stephen

Then I get a new file and the latest version looks like:
ID | Data
1a | John
2bx | Sam
2b | Clare
3c | Stephen

So I can't just copy paste the whole column, as the lines have moved essentially. Is there a way of getting Excel to check each cell, see if I have highlighted it green then copy paste it to the row with the right ID?

Thanks in advance! PS I've used Excel a fair amount, but never anything very complicated formula wise (never created a Maco for eg.)

Comfy · Jan 10, 2011

Hi gjgj,

Welcome to the Forums.

I have made a couple of assumptions for this code but we can change it if you need to.

1st - The workbook that you have been working on (the one with the updates) has been copied to a sheet in the New Workbook and Called Old Sheet

2nd - The sheet in the new workbook has been called New Sheet.

3rd - rather than searching by Cell colour I have simply just searched by ID, this will only work if you IDs are unique, if not will try and change to index color as your asked

Code:

Sub Sheet_Update()

    Dim IDstring As String
    Dim LastRow As Integer
    Dim IDint As Integer
    Dim i As Integer

    LastRow = Sheets("New Sheet").Columns(1).Find("*", SearchDirection:=xlPrevious).Row
    
            For i = 2 To LastRow
            On Error GoTo Here
            IDstring = Cells(i, 1).Value
            IDint = Sheets("Old Sheet").Columns(1).Find(IDstring, SearchDirection:=xlPrevious).Row

                If Sheets("New Sheet").Cells(i, 2).Value = Sheets("Old Sheet").Cells(IDint, 2).Value Then
                'Do Nothing As Both Values are the Same
                Else
                Sheets("New Sheet").Cells(i, 2).Value = Sheets("Old Sheet").Cells(IDint, 2).Value
                End If
Here:
            Next i

End Sub

Try this and see how it goes.

/Comf

gjgj · Jan 10, 2011

Wow that's excellent, many thanks!!!!

...but (give an inch take a mile eh?) if it's not a huge problem could I ask for some alterations?

1) Is it possible to do this between files? I ask as a lot of the time the files can be very large and have many sheets/tabs. Coping from the new file to the old whole tabs would be a large job by itself. Ideally this would be great if it could be done on a tab by tab basis between 2 separate files.

2) Does this work across other Columns? Sometimes it is not just names in ColB for instance, it can be further pieces of info in Col C / D / E etc etc

3) If possible can this work by cell colour highlighting or font colour or something? Mainly because if I receive a file with updates in it and new row has been inserted with errors introduced by someone else then I'll take responsibility if the correction is not highlighted if you know what I mean (which is why my changes must be distinguished in some way).

I know I'm asking a lot but I'll promote this site loads and click on the right a ds

!!

Thanks again

Comfy · Jan 10, 2011

Hi gjgj,

Try the following

Code:

Sub Sheet_Update()
    
    Dim WBold As Workbook
    Dim WSold As Worksheet
    
    Dim WBnew As Workbook
    Dim WSnew As Worksheet
    
    Dim strPath As String
    Dim IDstring As String
    Dim LastRow As Integer
    Dim LastCol As Integer
    Dim IDint As Integer
    Dim i As Integer
    Dim j As Integer

    strPath = Application.GetOpenFilename(, , "Select your original File")
    Set WBold = Application.Workbooks(GetFilenameFromPath(strPath))
    Set WSold = WBold.Worksheets("old")
    
    strPath = Application.GetOpenFilename(, , "Select your new File")
    Set WBnew = Application.Workbooks(GetFilenameFromPath(strPath))
    Set WSnew = WBnew.Worksheets("new")
    
    LastRow = WSold.Columns(1).Find("*", SearchDirection:=xlPrevious).Row
    LastCol = WSold.Rows(1).Find("*", SearchDirection:=xlPrevious).Column
    
            For i = 2 To LastRow
                For j = 2 To LastCol
            On Error GoTo Here
            IDstring = WSold.Cells(i, 1).Value
                If WSold.Cells(i, j).Interior.ColorIndex = 4 Then
                    IDint = WSnew.Columns(1).Find(IDstring, SearchDirection:=xlPrevious).Row
                    WSnew.Cells(IDint, j).Value = WSold.Cells(i, j).Value
                    WSnew.Cells(IDint, j).Interior.ColorIndex = WSold.Cells(i, j).Interior.ColorIndex
                Else
                End If
Here:
                Next j
            Next i

End Sub
 Function GetFilenameFromPath(ByVal strPath As String) As String
    
    If Right$(strPath, 1) <> "\" And Len(strPath) > 0 Then
        GetFilenameFromPath = GetFilenameFromPath(Left$(strPath, Len(strPath) - 1)) + Right$(strPath, 1)
    End If
End Function

This will open two file browser windows for you to chose the files. They must be open prior to starting the Macro. I haven't included a "Check File is Open" if statement.

For now the sheets must be called "New" and "Old" you can obviously change this or there maybe another way to dynamically set these.

This will update the New Wrkbk sheet with the Old updated value and also make the Cell Green (Color Index 4).

At the moment Each Worksheet must have the same column layout. But it wouldn't be too difficult to change this if they are not.

I think that was everything.

/Comf

gjgj · Jan 11, 2011

Thank you very much again for your response! One problem though -- I can't get it to work

I paste and play, choose the Marco name (Sheet_Update) and choose the files. No warning or errors appear. I go back to the files and they are as they were with no texts updated. I tried naming the tabs old - new / Old - New but it doesn't make a difference. I tried creating two new files from scratch but again no result.

Also, if I could be ultra cheeky, there was one thing that you mentioned you updated: the cells that are exported from the old sheet will then be highlighted green in the new sheet. If at all possible, can the script look for cells in the old sheet/file that are highlighted and only export these to the new sheet/file (and also highlight in the new file)?
What can happen sometimes is that a new file recieved would contain changes to cells that I didn't touch. If the script exports all differences (non-highlighted cells included) then these would be overwritten. I can always identify my changes with font colour or something else if cell fill can't be used...

I know I'm asking for quite a bit at this stage, so if it's not possible then no worries

Thanks again!!!!!!

Comfy · Jan 11, 2011

A Reason that it may not be working is due to the cell colour you are using, macro is using. The colour index has been set to 4.

gjgj said:
Also, if I could be ultra cheeky, there was one thing that you mentioned you updated: the cells that are exported from the old sheet will then be highlighted green in the new sheet. If at all possible, can the script look for cells in the old sheet/file that are highlighted and only export these to the new sheet/file (and also highlight in the new file)?

This is what the Macro currently does.

It will search your old sheet for cells that are filled with Light Green, index 4, take the value of this Cell and Paste it into the New sheet based on the ID Value in Column A and the Column Number of the Cell. It will then change this Cell to Light Green Also.

there are some Custom Functions Here that will help you to find what the index number is of the colour you are using.

Once you find out the Index Number Change it Here:

Code:

If WSold.Cells(i, j).Interior.ColorIndex = 4 Then 'Change This ColorIndex Number
                    IDint = WSnew.Columns(1).Find(IDstring, SearchDirection:=xlPrevious).Row
                    WSnew.Cells(IDint, j).Value = WSold.Cells(i, j).Value
                    WSnew.Cells(IDint, j).Interior.ColorIndex = WSold.Cells(i, j).Interior.ColorIndex
                Else
                End If

gjgj · Jan 12, 2011

You're my new hero Comfy! Thanks again for all your help

Comfy · Jan 12, 2011

Glad it worked.

gjgj · Feb 23, 2011

Hello again, I'm back with a small request for an amendment:

is it possible to have this function work without specifying tab names? I have come accross files with a huge amount of tabs and it's almost not worth using the Marco with it! The tab names are always the same between the two files.

Thanks again!

Comfy · Mar 11, 2011

Emailed to you but posted here for anyone else's perusal.

Code:

Sub Sheet_Update()
    
    Dim WBold As Workbook
    Dim WSold As Worksheet
    
    Dim WBnew As Workbook
    Dim WSnew As Worksheet
    
    Dim ws As Worksheet
    
    Dim strPath As String
    Dim IDstring As String
    Dim LastRow As Integer
    Dim LastCol As Integer
    Dim IDint As Integer
    Dim i As Integer
    Dim j As Integer

    strPath = Application.GetOpenFilename(, , "Select your original File")
    If strPath = "" Then Exit Sub
    Set WBold = Application.Workbooks(GetFilenameFromPath(strPath))
    
    strPath = Application.GetOpenFilename(, , "Select your new File")
    If strPath = "" Then Exit Sub
    Set WBnew = Application.Workbooks(GetFilenameFromPath(strPath))
    
    For Each ws In WBold.Worksheets
    
    Set WSold = ws
    Set WSnew = WBnew.Worksheets(ws.Name)
    
    LastRow = WSold.Columns(1).Find("*", SearchDirection:=xlPrevious).Row
    LastCol = WSold.Rows(1).Find("*", SearchDirection:=xlPrevious).Column
            For i = 2 To LastRow
                For j = 2 To LastCol
                    On Error GoTo Here
                    IDstring = WSold.Cells(i, 1).Value
                    If WSold.Cells(i, j).Interior.ColorIndex = 43 Then
                        IDint = WSnew.Columns(1).Find(IDstring, After:=WSnew.Cells(1, 1), LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, SearchDirection:=xlNext).Row
                        WSnew.Cells(IDint, j).Value = WSold.Cells(i, j).Value
                        WSnew.Cells(IDint, j).Interior.ColorIndex = WSold.Cells(i, j).Interior.ColorIndex
                    Else
                    End If
Here:
                Next j
            Next i
    Next

End Sub
 Function GetFilenameFromPath(ByVal strPath As String) As String
    
    If Right$(strPath, 1) <> "\" And Len(strPath) > 0 Then
        GetFilenameFromPath = GetFilenameFromPath(Left$(strPath, Len(strPath) - 1)) + Right$(strPath, 1)
    End If
End Function

'Merging' with condidtions

gjgj

New Member

Excel Facts

Comfy

Well-known Member

gjgj

New Member

Comfy

Well-known Member

gjgj

New Member

Comfy

Well-known Member

gjgj

New Member

Comfy

Well-known Member

gjgj

New Member

Comfy

Well-known Member

Similar threads

Forum statistics

Share this page

'Merging' with condidtions

New Member

Excel Facts

Well-known Member

New Member

Well-known Member

New Member

Well-known Member

New Member

Well-known Member

New Member

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock