Question

Locked

Similar Row entries to column in Excel

By ervermasiddhant ·
Dear

I want to arrange a data in perticular maner

SAM Class 5
SAM 3256
SAM " Address "
SAM " Telephone No."
RAM Class 5
RAM 3356
RAM " Address "
RAM Telephone No."
and so on to

NAME RollNo Class ContactNo.
SAM 3256 Class 5 Telephone No
RAM 3356 Class 5 Telephone No

This conversation is currently closed to new comments.

3 total posts (Page 1 of 1)  
| Thread display: Collapse - | Expand +

All Answers

Collapse -

This might help with your Row issue......

http://office.microsoft.com/en-us/excel/HP052031381033.aspx

Collapse -

Combining multiple row data into 1 row

by Shriks In reply to Similar Row entries to co ...

I had a similar issue.Ex. using 4 columns separated by '|'
Row1: "A"|"B"|1|"r"
Row2: "A"|"B"|2|"p"
The result required should have read as
Row1: "A"|"B"|1,2| "r","p"

This can be applied with required changes:
--------------------
Sub DuplXclude()
Dim RowNum As Long, LastRow As Long
Application.ScreenUpdating = False
'start below title row and select full data
RowNum = 2
LastRow = Cells.SpecialCells(xlCellTypeLAstCell).Row
Range("A2", Cells(LastRow, 4).Select
For Each Row In Selection
With Cells
'check for blank cell
If Cells(RowNum,2) <> "" Then
Do
If Cells(RowNum,2) = Cells(RowNum+1,2) Then
'check and ignore duplicate cell values
If Cells(RowNum,3) <> Cells(RowNum+1,3) Then
'check blank value for next col cell
If Cells(RowNum+1,3) <> "" Then
'If string already is present ignore
If InStr(Cells(RowNum,3), Cells(RowNum+1,3)) = 0 Then
'else concat both values
Cells(RowNum,3) = Cells(RowNum,3) & "," & Cells(RowNum+1,3)
End If
End IF
End IF
'now check values on next column and do similar as above
If Cells(RowNum,4) <> Cells(RowNum+1,4) Then
If Cells(RowNum+1,4) <> "" Then
If InStr(Cells(RowNum,4), Cells(RowNum+1,4)) = 0 Then
Cells(RowNum,4) = Cells(RowNum,4) & "," & Cells(rowNum+1,4)
End IF
End IF
End IF
Delete the duplicate row from where the data has been copied above
Rows(RowNum +1).EntireRow.Delete
End IF
Loop Until Cells(RowNum,2) <> Cells(RowNum+1, 2)
END IF
End With
RowNum = RowNum+1
Next Row
Application.ScreenUpdating = True
End Sub

Back to Software Forum
3 total posts (Page 1 of 1)  

Related Discussions

Related Forums