View Full Version : Main characters to merge with Sub-characters in record
gentle2005
10-27-2016, 03:15 AM
Hi,
I have sample file attached for the merger of main test characters with the sub-characters. I have 10k number of rows wherein different main characters to merge with sub-characters nearly 3k rows. could somebody help me with VBA code to make life easier? comment the code to understand VBA logic. Thank you.
Paul_Hossler
10-27-2016, 07:31 AM
This is marked [Solved] -- did you figure it out?
gentle2005
10-27-2016, 08:05 AM
No. I am surprised to see it as "solved". Problem remain standstill.
Paul_Hossler
10-27-2016, 08:58 AM
OK, this macro runs on a sheet called 'Data' a copy of your input - change the name if you want
Option Explicit
Sub MergeCharacteristics()
    Dim iLastRow As Long, iRowWithData As Long, iRow As Long
    Dim wsData As Worksheet
    Dim rBlanks As Range, rCell As Range
    
    
    'faster
    Application.ScreenUpdating = False
    
    'save the data sheet in variable
    Set wsData = Worksheets("Data")
    'using  'With' assume that all <dot>somethings refer to wsData - clearer and saves typing.
    'some people think it's faster also
    With wsData
        'from last row in the WS, col 2 go up to find first non-empty cell
        iLastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
        'hold just the empty cells in col A = 1 in a Range variable (have to use 'Set' for objects)
        Set rBlanks = .Range(.Cells(1, 1), .Cells(iLastRow, 1)).SpecialCells(xlCellTypeBlanks)
        'go through each of the empty cells in rBlanks
        For Each rCell In rBlanks.Cells
            'if the cell one col over is not blank
            If Len(rCell.Offset(0, 1).Value) > 0 Then
                    
                'go up and find a non-empty cell up from the blank one
                iRowWithData = rCell.End(xlUp).Row
        
                'make the cell to the left of the empty one = the data from the non-empty cell above + the original data
                'note the dot on Cells to use wsData
                rCell.Offset(0, 1).Value = .Cells(iRowWithData, 2).Value & " " & rCell.Offset(0, 1).Value
            End If
        Next
        'cleanup the second col
        For iRow = 2 To iLastRow
            'worksheet Trim() acts differently than VBA Trim
            .Cells(iRow, 2).Value = Application.WorksheetFunction.Trim(.Cells(iRow, 2).Value)
        Next iRow
    End With
    Application.ScreenUpdating = True
End Sub
gentle2005
10-27-2016, 10:46 PM
Thank you. Mission accomplished!!! but need some changes like the file attached. I want to learn VBA becoz it is thrilling me always; just 8 lines of code make millions of rows obey. As a VBA expert, guide me where and how to start excel VBA. Thank you.
Powered by vBulletin® Version 4.2.5 Copyright © 2025 vBulletin Solutions Inc. All rights reserved.