S
savvysam
I got a VB program from this board, and am trying to expand the ranges to
Columns A-G and combine contents of C if all other data in row matches that
of any other row, and if so then combine contents of column C in those rows
and delete extras. Tried to manually add in additional columns, as you'll
see below but keep getting object or application runtime error. Any
thoughts? Thanks!! I'll clarify if needed, Thx
Sub Concat()
Dim Iloop As Integer
Dim Numrows As Integer
Dim Counter As Integer
Application.ScreenUpdating = False
Numrows = Range("A65536").End(xlUp).Row
Range("A1:G" & Numrows).Select
Selection.Sort key1:=Range("A1"), Order1:=xlAscending, _
Key2:=Range("B1"), Order2:=xlAscending, Key3:=Range("C1"), _
Order3:=xlAscending, key4:=Range("D1"), Order4:=xlAscending, _
key5:=Range("E1"), Order5:=xlAscending, key6:=Range("F1"),
Order6:=xlAscending, _
key7:=Range("G1"), Order7:=xlAscending, Header:=xlYes, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
For Iloop = Numrows To 2 Step -1
If Cells(Iloop, "A") & Cells(Iloop, "B") & Cells(Iloop, "D") &
Cells(Iloop, "E") & Cells(Iloop, "F") & Cells(Iloop, "G") _
= Cells(Iloop - 1, "A") & Cells(Iloop - 1, "B") & Cells(Iloop - 1, "D")
& Cells(Iloop - 1, "E") & Cells(Iloop - 1, "F") & Cells(Iloop - 1, "G") Then
Cells(Iloop - 1, "C") = Cells(Iloop - 1, "C") & ", " & Cells(Iloop, "C")
Rows(Iloop).Delete
End If
Next Iloop
Range("A1").Select
Application.ScreenUpdating = True
End Sub
Columns A-G and combine contents of C if all other data in row matches that
of any other row, and if so then combine contents of column C in those rows
and delete extras. Tried to manually add in additional columns, as you'll
see below but keep getting object or application runtime error. Any
thoughts? Thanks!! I'll clarify if needed, Thx
Sub Concat()
Dim Iloop As Integer
Dim Numrows As Integer
Dim Counter As Integer
Application.ScreenUpdating = False
Numrows = Range("A65536").End(xlUp).Row
Range("A1:G" & Numrows).Select
Selection.Sort key1:=Range("A1"), Order1:=xlAscending, _
Key2:=Range("B1"), Order2:=xlAscending, Key3:=Range("C1"), _
Order3:=xlAscending, key4:=Range("D1"), Order4:=xlAscending, _
key5:=Range("E1"), Order5:=xlAscending, key6:=Range("F1"),
Order6:=xlAscending, _
key7:=Range("G1"), Order7:=xlAscending, Header:=xlYes, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
For Iloop = Numrows To 2 Step -1
If Cells(Iloop, "A") & Cells(Iloop, "B") & Cells(Iloop, "D") &
Cells(Iloop, "E") & Cells(Iloop, "F") & Cells(Iloop, "G") _
= Cells(Iloop - 1, "A") & Cells(Iloop - 1, "B") & Cells(Iloop - 1, "D")
& Cells(Iloop - 1, "E") & Cells(Iloop - 1, "F") & Cells(Iloop - 1, "G") Then
Cells(Iloop - 1, "C") = Cells(Iloop - 1, "C") & ", " & Cells(Iloop, "C")
Rows(Iloop).Delete
End If
Next Iloop
Range("A1").Select
Application.ScreenUpdating = True
End Sub