Search code examples
excelvbacellrows

How to copy cell values from WorkSheet1 to WorkSheet, aka, how to create a masterlist in Excel using VBA?


I am trying to create a master list of several excel data that I have. I have never worked with Excel + VBA programs/codes.

There are 2 columns in WorkSheet1. The Column1 is some sort of word(s), terminology and the Column2 holds the definition for Column1. Now, I have to copy the definition of that Column1 and put in the Column2(if empty, if not, then in Column3 or the next empty column) in WorkSheet2 right next to the corresponding Column1. Continue doing this for the rest of the Rows in WorkSheet1. Basically, there should not be any repetition of the same values. The Column1 in WorkSheet2 can have more than 1 definition Columns, as long as they are not the same.

Does this make sense? Is it possible to do something like this? Thanks in advance!


Solution

  • Welcome to Excel VBA. If I understand your post correctly, this should give you (at the least basics of) what you are after. This may need to tweaking based on your specific workbook and data sets, but it will give you a GREAT start. There is a plethora of help available on all the methods / procedures I've used, and I've tried to comment well in English so you can understand what is happening.

    Option Explicit
    
    Sub MoveIt()
    
    Dim wkb As Workbook
    Set wkb = ActiveWorkbook 'change to your workbook reference
    
    Dim wks1 As Worksheet, wks2 As Worksheet
    Set wks1 = wkb.Sheets("Sheet1") 'change to your name / definition sheet
    Set wks2 = wkb.Sheets("Sheet2") 'change to the sheet where you need to paste defintions
    
    With wks1
    
        Dim rngLoop As Range, cel As Range
        'assumes row 1 as column header, and definitions in Column B (2)
        Set rngLoop = Intersect(.UsedRange, .UsedRange.Offset(1), .Columns(2)) 'basically all rows with definitions in Column 2
    
        For Each cel In rngLoop 'loop through each definition
    
    
            Dim rngFound As Range
    
            'look for associated definition name in 2nd sheet
            'assumes Name in Column 1 of both worksheets
            Set rngFound = wks2.Columns(1).Find(cel.Offset(, -1).Text, lookat:=xlWhole)
    
    
            If Not rngFound Is Nothing Then 'if the name is found
    
                'look to see if defintion already exists in row aligned with Name of 2nd sheet
                Dim rngFoundAgain As Range
                Set rngFoundAgain = rngFound.EntireRow.Find(cel.Text,lookat:=xlWhole)
    
                'if not found
                If rngFoundAgain Is Nothing Then
    
                    If rngFound.Offset(, 1) = vbNullString Then
                    'if next cell (row of rngFound, column B) is blank
    
                        rngFound.Offset(, 1) = cel.Text
    
                    Else
                    'go the right most cell and place definition in next column
    
                        rngFound.End(xlToRight).Offset(, 1) = cel.Text
    
                    End If
    
                End If
    
            End If
    
        Next
    
    End With
    
    
    End Sub