How would one merge this into 1 cell

[Riskybizniz]

User1 User2
----------------------------------------
Table1 Create 1 1
Table1 Alter 1
Table2 Create 1
Tabel2 Alter 1 1

What I need to do is substitute the 1's with the value in column 2 and,
ideally, if the tablename is the same (column1) put both values in column2
into 1 cell. I need to do this for a sheet with approx 30 columns (only 1st 2
have values as above) amd 3000+ rows.

I am somewhat familiar with macros and vb but this is beyond me (i think),
any pointers greatly appreciated.

have a good weekend!

 

[Barb Reinhardt]

Your request is a bit cryptic. Could you provide some additional info?

 

[Riskybizniz]

Dear Barb, ofcourse.
the columns are userids, the rows are tables (col1) and rights (col2).
the 1's indicate that a user has the right on that specific table. Col1 has,
as said, the tables and this value repeats for each right on that table. What
I need to do is a) replace the cell with 1st occurence (the '1' under user)
with all the rights listed in col2 and then b) condense all the tables into 1
per table so that the sheet would look like this:
Table: | Right | User1 | User 2 |
+------+--------+--------------+---------------+
|table1| |Create, Alter|Create |
+------+-------+---------------+---------------+
|table2| |Create |Create, Alter|
+------+-------+---------------+---------------+
If you use the 'table' listed in my first post.
Does this clarify my question somewhat?
kindest regards,
Chris

 

[Dave Peterson]

Try this against a copy of your worksheet--it destroys the original when it's
working.

Option Explicit
Sub testme()

Dim wks As Worksheet
Dim iRow As Long
Dim iCol As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim FirstCol As Long
Dim LastCol As Long
Dim mySep As String

Set wks = Worksheets("Sheet1")

With wks
FirstRow = 2 'headers in row 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
FirstCol = 1
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column

'sort the data by column A
With .Range(.Cells(FirstRow - 1, FirstCol), .Cells(LastRow, LastCol))
.Cells.Sort key1:=.Columns(1), order1:=xlAscending, _
key2:=.Columns(2), order2:=xlAscending, _
header:=xlYes
End With

With .Range(.Cells(FirstRow, FirstCol + 2), .Cells(LastRow, LastCol))
'no formulas!
.Value = .Value
On Error Resume Next 'just in case
.Cells.SpecialCells(xlCellTypeConstants).FormulaR1C1 = "=rc2"
On Error GoTo 0
.Value = .Value
End With

For iRow = LastRow To FirstRow + 1 Step -1
If .Cells(iRow, "A").Value = .Cells(iRow - 1, "A").Value Then
'still in same group, do some work
For iCol = FirstCol + 2 To _
.Cells(iRow, .Columns.Count).End(xlToLeft).Column
If .Cells(iRow, iCol).Value = "" Then
'skip it
Else
mySep = ", "
If .Cells(iRow - 1, iCol).Value = "" Then
mySep = ""
End If
.Cells(iRow - 1, iCol).Value _
= .Cells(iRow - 1, iCol).Value _
& mySep & .Cells(iRow, iCol).Value
End If
Next iCol
'do with that row
.Rows(iRow).Delete
End If
Next iRow
'delete column B????
.Columns(FirstCol + 1).Delete
'fit the columns
.UsedRange.Columns.AutoFit
End With
End Sub