VBA To Copy Data Particular To Separate Worksheet Based On Cell Value

oldeirish

New Member
Joined
Nov 24, 2014
Messages
40
Hi,
My workbook has contains two sheets that are used as follows. The first sheet (Current Data Source) downloads data from a remote database into 6 columns of data. The next week, I transfer this data (using VBA code) into another worksheet, with same six columns called Previous Data Source and download the new data to Current Data Source.
In Columns D the data is split into 4 criteria, Quote, HP, LP and Conf. I’d like to have VBA macros to copy only the data, from Columns A and D on both sheets that have changed since the previous week based on a cell value. The VBA code to compare only the data in Column A (Names) that have changed with the cell value in Column D (Status) from either Quote, HP, LP to “Conf”.
I’ve tried many different codes and tried several formulas as well, from VLOOKUP to INDEX and MATCH, but can’t seem to get it right. I’m new to VBA and am trying to understand it better each day, so I apologize if my request does not make a lot of sense. I’m appealing to all Excel wizards out there who can write this code in the hopes that I not lose any more hair! lol
 
I think this will do it.
Code:
Sub compare()
Dim sh1 As Worksheet, sh2 As Worksheet, lr As Long, fn As Range
Set sh1 = Sheets("Current_Data_Source")  'Edit sheet name - This is current data
Set sh2 = Sheets("Prev_Data_Source") 'Edit sheet name - This is prev data
lr = sh1.Cells(Rows.Count, 1).End(xlUp).Row
    For Each c In sh1.Range("A2:A" & lr)
        Set fn = sh2.Range("A:A").Find(c.Value, , xlValues, xlWhole)
            If Not fn Is Nothing Then
                If c.Offset(0, 3) <> "Conf" And fn.Offset(0, 3) = "Conf" Then
                    c.Resize(1, 4).Interior.ColorIndex = 6
                End If
            End If
    Next
End Sub

Thanks JLGWhiz, but this one produces nothing. I ran the report a couple different times with numerous data changes, but nothing comes up. Shall I send you a watered down copy? As I may not be explaining what i need properly. Would that be okay? If so, can send me your email details?

Thanks!!!!
 
Upvote 0

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
Thanks JLGWhiz, but this one produces nothing. I ran the report a couple different times with numerous data changes, but nothing comes up. Shall I send you a watered down copy? As I may not be explaining what i need properly. Would that be okay? If so, can send me your email details?

Thanks!!!!

i do not accept direct submissions to my private email account. If you read the Posting Guidelines for this site, you will see the alternative methods for posting your product either in the thread or at a share server, with the link to that server then posted in the thread here. As I understood your post, you want to locate any name, that is in the current download of data, in the previous week's data to determine if the status went to "Conf" from whatever it was the previous week. My understanding was also that the names were in column A and the status was in column D. That is the criteria that was used to set up a mock up of your file and test the macro. The macro produced the expected result and ran without error under those assumptions.

the code should be copied to the standard code module 1, not the sheet code module.
 
Last edited:
Upvote 0
Hi,

I was incorrect, it does highlight the names in the A column in the CDS page. Sorry, just one more question. How do I take those names and put them in a separate page/report that either automatically deletes each week, or I can put a Clear Data Macros on it. My apologies for my last response.
 
Upvote 0
The criteria appears to be reversed on this line:
Code:
If c.Offset(0, 3) <> "Conf" And fn.Offset(0, 3) = "Conf" Then
Change it to this:
Code:
If c.Offset(0, 3) = "Conf" And fn.Offset(0, 3) <> "Conf" Then
 
Upvote 0
To list the items on a separate worksheet, you can add a line of code after the line that adds the color.
Code:
Dim sh3 As Worksheet 'This goes at the top with the other Dim statements, but on a separate line.
Set sh3 = Sheets(3) 'Needs a name like:  Sheets("Report") and can also be at the top where the other set statements are
c.Resize(1, 4).Copy sh3.Cells(Rows.Count, 1).End(xlUp)(2) ' this is the one that goes after the color statement.

This should then build a list of items on a third sheet as they are identified and highlighted.
 
Upvote 0
Thanks JLGWhiz! I'm very thankful you took the time to address this question, it is greatly appreciated. I do have one more question for you, if that's ok. I added your code, and instead of just copying the highlighted cells, it copied the entire sheet. Can you see what I did wrong? Thank you again!!!

Code:
Sub Compare_Conf()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, lr As Long, fn As Range
Set sh1 = Sheets("Current_Data_Source")
Set sh2 = Sheets("Prev_Data_Source")
Set sh3 = Sheets("Update_Conf_Status")
lr = sh1.Cells(Rows.Count, 1).End(xlUp).Row
    For Each c In sh1.Range("A2:A" & lr)
        Set fn = sh2.Range("A:A").Find(c.Value, , xlValues, xlWhole)
            If Not fn Is Nothing Then
               If c.Offset(0, 3) = "Conf" And fn.Offset(0, 3) <> "Conf" Then
                    c.Resize(1, 4).Interior.ColorIndex = 6
                End If
    c.Resize(1, 4).Copy sh3.Cells(Rows.Count, 1).End(xlUp)(2)
            End If
    Next
End Sub
 
Upvote 0
Hi,

I changed it to this...

Code:
Sub Compare_Conf()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, lr As Long, fn As Range
Set sh1 = Sheets("Current_Data_Source")
Set sh2 = Sheets("Prev_Data_Source")
Set sh3 = Sheets("Update_Conf_Status")
lr = sh1.Cells(Rows.Count, 1).End(xlUp).Row
    For Each c In sh1.Range("A2:A" & lr)
        Set fn = sh2.Range("A:A").Find(c.Value, , xlValues, xlWhole)
            If Not fn Is Nothing Then
               If c.Offset(0, 3) = "Conf" And fn.Offset(0, 3) <> "Conf" Then
                    c.Resize(1, 4).Interior.ColorIndex = 6
                    c.Resize(1, 4).Copy sh3.Cells(Rows.Count, 1).End(xlUp)(2)
                End If
    
            End If
    Next
End Sub
 
Upvote 0
Now I am confused. If sh1 is the recently downloaded data and sh2 is the previous week's data then column D in sh1 would be the the cell to check for each name to determine if "Conf" appears. If it appears there, but not in the previous week's column D for the same name, then that would be an item to highlight and report. Is that a true statement? If it is then the code should only be producing items that meet that criteria. Did you look at both sheets to determine if what the code did was a result of what is actually on the sheet. In other words, check the names on the third sheet and see if they meet the criteria to be selected. The code below is arranged more logically, maybe that will fix the anomally.
Code:
Sub Compare_Conf()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, lr As Long, fn As Range
Set sh1 = Sheets("Current_Data_Source")
Set sh2 = Sheets("Prev_Data_Source")
Set sh3 = Sheets("Update_Conf_Status")
lr = sh1.Cells(Rows.Count, 1).End(xlUp).Row
    For Each c In sh1.Range("A2:A" & lr)
        Set fn = sh2.Range("A:A").Find(c.Value, , xlValues, xlWhole)
            If Not fn Is Nothing Then
               If c.Offset(0, 3) = "Conf" And fn.Offset(0, 3) <> "Conf" Then
                    c.Resize(1, 4).Interior.ColorIndex = 6
                    c.Resize(1, 4).Copy sh3.Cells(Rows.Count, 1).End(xlUp)(2)
                End If
            End If
    Next
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,275
Messages
6,171,126
Members
452,381
Latest member
Nova88

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top