PDA

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.