Move cell data based on multiple criteria matching per row between two sheets

[morgrim]

Hello everyone,


I am new to this site and forums in general. Hopefully I won't break any rules of any sort. I am "maybe" an advanced beginner at Excel in general use terms (No macro/VBA experience) just so everyone knows. That tidbit of info might help with any answers I receive for this post as they may have to be explained a bit.


What I am attempting to do is find a way that will allow me to receive new data on a monthly basis in an excel xlsx file (not my choice for file type) from another organization in my company. The spreadsheet is used to track revenue. I have excel 2011 on the mac platform for reference purposes.


The details:
Each month I receive a spreadsheet with 100’s - 1000’s of rows in it. I filter out the rows pertinent to my organization and cut/paste them into an existing workbook that has a tab for each month of the of the year. For example, on January 4th I will receive a xlsx file containing December data.


The data for December will have 100's to 1000's of rows that existed in November file as well. The Nov. data (on the Nov. tab) will have a extra columns that I added after pasting the original info I received. The new columns are AE - AK (all in between).


The ask:
I would like a solution (perhaps a macro/VBA enabled button) that I can use to check each row in the December Tab against every row in the November Tab (there will be only one exact match) and if there is a match I would like to copy over the values of AE - AK columns cells on the November tab for the matching row to the columns AE-AK cells on the December tab for the identical row entry (rows not numerically identical). The match can be determined using multiple cell values for a given row in the spreadsheet. In order to determine an exact match on a per row basis the following columns would have to match on both sheets: A,B,J,L,O,T,AC.


I am hoping this is possible as 10s/100s of person hours are wasted on this activity monthly/annually.


Any help that can be provided would be greatly appreciated. If there is anything else I can add/provide please let me know.


I apologize in advance if this an inappropriate help request or the wrong place for such a request.


v/r
Eric

 

[svendiamond]

I would like a solution (perhaps a macro/VBA enabled button) that I can use to check each row in the December Tab against every row in the November Tab (there will be only one exact match) and if there is a match I would like to copy over the values of AE - AK columns cells on the November tab for the matching row to the columns AE-AK cells on the December tab for the identical row entry (rows not numerically identical). The match can be determined using multiple cell values for a given row in the spreadsheet. In order to determine an exact match on a per row basis the following columns would have to match on both sheets: A,B,J,L,O,T,AC.

If a row in November columns A, B, J, L, O, T, AC = December same columns, then copy AE:AK (of that row) from November sheet, to AE:AK on December sheet (same row)? Is this correct?

 

[morgrim]

Yes to both. Copy to same row on December sheet for the columns you indicated.

Also, there should only be one match in the November tab for any given row in the December tab "if" on exists at all. Not sure if that is important or not.

Thanks so much for your reply!

 

[svendiamond]

This code could probably be a lot shorter and more effective but it should work:

Sub copyOver()


Dim rowLoop As Long, loop2 As Long, lastRow As Long, lastRow2 As Long
Dim ws1 As Worksheet, ws2 As Worksheet
Dim myString1 As String, myString2 As String


Set ws1 = Sheets("November")
Set ws2 = Sheets("December")
    lastRow = ws1.Cells(Rows.Count, 1).End(xlUp).Row
    lastRow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row


    For rowLoop = 2 To lastRow
        With ws1
        myString1 = .Range("A" & rowLoop).Value & _
                    .Range("B" & rowLoop).Value & _
                    .Range("J" & rowLoop).Value & _
                    .Range("L" & rowLoop).Value & _
                    .Range("O" & rowLoop).Value & _
                    .Range("T" & rowLoop).Value & _
                    .Range("AC" & rowLoop).Value
        End With
            'find match
            With ws2
                For loop2 = 2 To lastRow2
                    myString2 = .Range("A" & loop2).Value & _
                                .Range("B" & loop2).Value & _
                                .Range("J" & loop2).Value & _
                                .Range("L" & loop2).Value & _
                                .Range("O" & loop2).Value & _
                                .Range("T" & loop2).Value & _
                                .Range("AC" & loop2).Value
                        If myString1 = myString2 Then
                            ws1.Range("AE" & rowLoop & ":AK" & rowLoop).Copy _
                                ws2.Range("AE" & rowLoop)
                        End If
                Next loop2
            End With
        
    Next rowLoop


End Sub

 

[morgrim]

svendiamond,

Thank you for this code, it's working. I have to try and figure out why some of the matches aren't correlating but I suspect it is because of human data entry errors. Is it possible to remove leading and trailing blank spaces for each cell before matching? I figure it is and I can google that one probably. I am going to have to do more testing and try and narrow it down for the ones that aren't matching but upon first inspection it looks like they should match up. Makes me wonder if I need to be concerned about upper cases versus lower cases cell values, etc. I did realize that I had to remove the L column criteria as that is changing from month to month and I didn't realize it.

I think I am going to have to invest in a book or online training on VBA for excel. It appears I am missing out on a lot of functionality. Any recommendations? I am going to see what I can find out there for free to start with and go from there I think. Any great resources on the Internet that I should be aware of by chance?

Thank you so much for your assistance. Happy New Year!

v/r
Eric

 

[svendiamond]

Is it possible to remove leading and trailing blank spaces for each cell before matching?

There are various ways to do this. One example would be the TRIM function.

I think I am going to have to invest in a book or online training on VBA for excel. It appears I am missing out on a lot of functionality. Any recommendations?

Yes, check out Wise Owl Tutorials on YouTube: https://www.youtube.com/playlist?list=PLNIs-AWhQzckr8Dgmgb3akx_gFMnpxTN5

 

[morgrim]

svendiamond,

Thanks again for your reply. I changed the code to look like this a bit. I couldn't figure out how to trim the value of each cell in the concatenated match variables of myString1 and myString2. I was thinking I would try to trim each cell value and then uppercase myString1 and myString2 so that any data entry capitalization mistakes would be eliminated. I also added a prompt for the new sheet name and the source sheet name so it could be used without people having to modify the macro each month.

Would you be able to show me how to check and validate that the sheet names provided via the InputBox steps actually exist. I did figure out how to test if they are NULL and exit the sub-routine.

Here is my code so far:

Sub copyOver()




Dim rowLoop As Long, loop2 As Long, lastRow As Long, lastRow2 As Long
Dim ws1 As Worksheet, ws2 As Worksheet
Dim myString1 As String, myString2 As String
Dim newSheet, oldSheet As String




newSheet = InputBox(Prompt:="What is the name of the new data sheet?", Title:="Enter name of NEW data sheet")
oldSheet = InputBox(Prompt:="What is the name of the new data sheet you want to pull data from?", Title:="Enter name of OLD data sheet")


If newSheet = vbNullString Or oldSheet = vbNullString Then
    Exit Sub
End If


Set ws1 = Sheets(newSheet)
Set ws2 = Sheets(oldSheet)


'Set ws1 = Sheets("November")
'Set ws2 = Sheets("December")


lastRow = ws1.Cells(Rows.Count, 1).End(xlUp).Row
lastRow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row




    For rowLoop = 2 To lastRow
        With ws1
        myString1 = .Range("A" & rowLoop).Value & _
                    .Range("B" & rowLoop).Value & _
                    .Range("J" & rowLoop).Value & _
                    .Range("O" & rowLoop).Value & _
                    .Range("T" & rowLoop).Value & _
                    .Range("AC" & rowLoop).Value
'                    MsgBox ("myString1 = " & myString1)
'                    .Range("L" & rowLoop).Value & _


        End With
            'find match
            With ws2
                For loop2 = 2 To lastRow2
                    myString2 = .Range("A" & loop2).Value & _
                                .Range("B" & loop2).Value & _
                                .Range("J" & loop2).Value & _
                                .Range("O" & loop2).Value & _
                                .Range("T" & loop2).Value & _
                                .Range("AC" & loop2).Value
                                
'                                .Range("L" & loop2).Value & _


                        If myString1 = myString2 Then
                            ' MsgBox ("This row is a match!")
                            ws2.Range("AE" & rowLoop & ":AK" & rowLoop).Copy _
                                ws1.Range("AE" & rowLoop)


                        Else
                            ' MsgBox ("String1=" & myString1 & Chr(10) & Chr(10) & "String2=" & myString2)
                        End If
                        
                Next loop2
            
            End With
        
    Next rowLoop


'Wrap Text in New Sheet
ws1.Range("AE2" & ":AK" & lastRow).WrapText = True
                            
'Center text in cells
ws1.Range("AE2" & ":AK" & lastRow).HorizontalAlignment = xlLeft
ws1.Range("AE2" & ":AK" & lastRow).VerticalAlignment = xlCenter
                    
' Activate cell AE2 on New sheet once complete        
Worksheets(newSheet).Activate
Worksheets(newSheet).Range("AE2").Select


End Sub

Thanks again for all your help. Sorry to be a bother with the refinement. Please let me know if I have to start a new thread for this variation.

Morgrim

 

[morgrim]

svendiamond et'al,

I was able to piece together some error handling and I think it is working. Can you or another confirm my error handling for the the scenario where the user clicks the "Cancel" button on the input box? I want to learn how to do this cleanly and correctly according to best practices if someone has the time to show me my errors or better ways of doing this.

Option Explicit


Sub copyOver()


' ###############
' Declared variables
' ###############
Dim rowLoop As Long, loop2 As Long, lastRow As Long, lastRow2 As Long
Dim ws1 As Worksheet, ws2 As Worksheet
Dim myString1 As String, myString2 As String
Dim newSheet, oldSheet As String
Dim sheetValid As Integer


' ##########################################################
' Ask user for name of DESTINATION worksheet, validate the sheet exists
' ##########################################################
getNewSheetName:
newSheet = InputBox(Prompt:="What is the name of the NEW data sheet?", Title:="Enter name of NEW data sheet")


If newSheet = vbNullString Then
    MsgBox ("You selected the CANCEL Button, click OK to exit!")
    Exit Sub
End If


' Check to see if Sheet name provided actually exists
sheetValid = 0
Do While sheetValid <> 1
    On Error Resume Next
    Set ws1 = Sheets(newSheet)
    On Error GoTo 0
    If Not ws1 Is Nothing Then
        sheetValid = 1
    Else
        MsgBox ("The sheet name:  " & newSheet & "  entered doesn't exist!")
        GoTo getNewSheetName
    End If
Loop
' ######################


' ##########################################################
' Ask user for name of SOURCE worksheet, validate the sheet exists
' ##########################################################
getSourceSheetName:
oldSheet = InputBox(Prompt:="What is the name of the SOURCE data sheet you want to pull data from?", Title:="Enter name of SOURCE data sheet")


If oldSheet = vbNullString Then
    MsgBox ("You selected the CANCEL Button, click OK to exit!")
    Exit Sub
End If


' Check to see if Sheet name provided actually exists
sheetValid = 0
Do While sheetValid <> 1
    On Error Resume Next
    Set ws2 = Sheets(oldSheet)
    On Error GoTo 0
    If Not ws2 Is Nothing Then
        sheetValid = 1
    Else
        MsgBox ("The sheet name:  " & oldSheet & "  entered doesn't exist!")
        GoTo getSourceSheetName
    End If
Loop
' ######################


' Set worksheet names once confirmed to be valid above
Set ws1 = Sheets(newSheet)
Set ws2 = Sheets(oldSheet)


' Determine how many rows exist on each worksheet
lastRow = ws1.Cells(Rows.Count, 1).End(xlUp).Row
lastRow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row


' Test to see if each row of new sheet matches a pre-existing row on the SOURCE sheet
    For rowLoop = 2 To lastRow
        With ws1
        myString1 = .Range("A" & rowLoop).Value & _
                    .Range("B" & rowLoop).Value & _
                    .Range("J" & rowLoop).Value & _
                    .Range("O" & rowLoop).Value & _
                    .Range("T" & rowLoop).Value & _
                    .Range("AC" & rowLoop).Value
'                    MsgBox ("myString1 = " & myString1)
'                    .Range("L" & rowLoop).Value & _


        End With
            'find match
            With ws2
                For loop2 = 2 To lastRow2
                    myString2 = .Range("A" & loop2).Value & _
                                .Range("B" & loop2).Value & _
                                .Range("J" & loop2).Value & _
                                .Range("O" & loop2).Value & _
                                .Range("T" & loop2).Value & _
                                .Range("AC" & loop2).Value
                                
'                                .Range("L" & loop2).Value & _


                        If myString1 = myString2 Then
                            ' MsgBox ("This row is a match!")
                            ws2.Range("AE" & rowLoop & ":AK" & rowLoop).Copy _
                                ws1.Range("AE" & rowLoop)


                        Else
                            ' MsgBox ("String1=" & myString1 & Chr(10) & Chr(10) & "String2=" & myString2)
                        End If
                        
                Next loop2
            
            End With
        
    Next rowLoop


'Wrap Text in New Sheet for the data that was added
ws1.Range("AE2" & ":AK" & lastRow).WrapText = True
                            
'Center text in cells for the data that was added
ws1.Range("AE2" & ":AK" & lastRow).HorizontalAlignment = xlLeft
ws1.Range("AE2" & ":AK" & lastRow).VerticalAlignment = xlCenter


' Activate cell AE2 on New sheet once complete
Worksheets(newSheet).Activate
Worksheets(newSheet).Range("AE2").Select


End Sub

Thanks in advance,
Morgrim