Compare Before Insert Excel

Hello All,

I have a compare / insert issue before copy paste. Basically, data from SourceSRC is getting copy-pasted over to MainSRC. Now SourceSRC usually has lesser columns. Instead of manually inserting blank columns into the SourceSRC table, can a VBA do that, to make sure the data getting copy pasted is happening between identical column count tables…now the mainSRC is the standard table, so the SourceSRC has to have the blank columns inserted to match with the standard table before getting copied – pasted over

VBA pseudo
Go Through each column header cells in mainSRC
      If a column header column is missing in SourceSRC (that is present in mainSRC) – then insert that a brand new column in SourceSRC with the column header name
Loop till the last header cell in mainSRC

Thank you
Compare-Insert-Bfr-CopyPaste.xlsx
RayneAsked:
Who is Participating?
 
nutschCommented:
Here's the code. It won't copy the data yet, but it will insert and move columns if required.

Sub MatchColumns()
'Matches two ranges by inserting columns in both ranges so each value is on the same column

'you first need to
'   select the two data blocks you want to split and match

Dim rg1 As Range, rg2 As Range
Dim firstMatch As Boolean
Dim i As Long, j As Long, foundCol As Long

Application.ScreenUpdating = False

    Set rg1 = Sheets("mainSRC").[b4].CurrentRegion
    Set rg2 = Sheets("sourceSRC").[b7].CurrentRegion
    
    'gets the number of unique values in the first rows of range 1 and 2, to be able to run the loop all the way
    Dim cUnique As New Collection
    
    On Error Resume Next
    
    With rg1
        For i = 1 To .Rows(1).Cells.Count
            cUnique.Add .Cells(1, i), CStr(.Cells(1, i))
        Next
    End With
    
    With rg2
        For i = 1 To .Rows(1).Cells.Count
            cUnique.Add .Cells(1, i), CStr(.Cells(1, i))
        Next
    End With
    
    On Error GoTo 0
    
    'boolean needed to be able to resize range 2 if required
    firstMatch = True
    
    For i = 1 To cUnique.Count
        If Len(rg1.Cells(1, i)) = 0 Or rg2.Cells(1, i) = rg1.Cells(1, i) Then
            firstMatch = False
            GoTo nxt_i:
        End If
        
        On Error Resume Next
        foundCol = rg2.Rows(1).Find(What:=rg1.Cells(1, i), LookIn:= _
            xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False).Column
        
        If Err <> 0 Then
            Err.Clear
            rg2.Offset(, i - 1).Resize(, 1).Insert Shift:=xlToRight
            If firstMatch Then Set rg2 = rg2.Offset(, -1).Resize(, rg2.Columns.Count + 1)
        Else
            rg2.Columns(foundCol - rg2.Column + 1).Cut
            rg2.Columns(i + rg2.Column - 1).Insert Shift:=xlToRight
            firstMatch = False
        End If
    
nxt_i:
    
    Next

Application.ScreenUpdating = True
End Sub

Open in new window


Thomas
0
 
RayneAuthor Commented:
Perfection to the Ultimate,

Thank you Thomas,
0
 
nutschCommented:
Glad I had something in my macro toolbox for you. Thanks for the kind words.

Thomas
0
 
RayneAuthor Commented:
You are welcome :)
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.