This could be a tough question to answer without more information from you.
If I assume that you only want to capture the first instance of the data in
column B the first time (instead of the last time) that it is used, then
within the first if statement, just after the else statement, change this to
perform a search of the data from row 1 to the row before rowcount by using
something like a selection.find operation to find the value of the current
"Range". If the value is not found then run the
Data = Data & ";" ...etc.
if the data is found then do nothing.
So the following will combine the rows into a single cell and maintain your
original data integrity, placing the result (data not previously found in
column B) in the row that contains data in column A.
Option Explicit
Public Sub testCombineRows()
Dim RowCount As Long
Dim Data As String
Dim FirstRowData As Long
RowCount = 1
Data = ""
FirstRowData = RowCount
Do While Range("B" & RowCount) <> ""
If RowCount > 1 Then
Range("B1:B" & RowCount - 1).Select
Else
'At the first row, but still want to add it.
End If
If RowCount = 1 Then
Data = Range("B" & RowCount)
ElseIf Selection.Find(Range("B" & RowCount)) Is Nothing And RowCount >
1 And Data = "" Then
Data = Range("B" & RowCount)
ElseIf Selection.Find(Range("B" & RowCount)) Is Nothing Then
Data = Data & ";" & Range("B" & RowCount)
Else
'The data has been found before
End If
If Range("A" & (RowCount + 1)) <> "" Or Range("B" & (RowCount + 1)) = ""
Then
Range("C" & FirstRowData) = Data
Data = ""
RowCount = RowCount + 1
FirstRowData = RowCount
Else
RowCount = RowCount + 1
'Rows(RowCount).Delete
End If
Loop
Worked for me, hope it does what you wanted. (I commented out the
Rows(RowCount).Delete line so that no data would not be deleted.
End Sub
"nmpb" wrote:
> could you also exclude the duplicates in column B.
>
> Thank you
>
> "nmpb" wrote:
>
> > Thank you for such a quick response. It works.
> > Can you change it so that the result appears in column C please so it does
> > not overwrite the data in column B.
> >
> >
> > "Joel" wrote:
> >
> > > Sub CombineRows()
> > >
> > > RowCount = 1
> > > Data = ""
> > > Do While Range("B" & RowCount) <> ""
> > > If Data = "" Then
> > > Data = Range("B" & RowCount)
> > > Else
> > > Data = Data & ";" & Range("B" & RowCount)
> > > End If
> > >
> > > If Range("A" & (RowCount + 1)) <> "" Then
> > > Range("B" & RowCount) = Data
> > > Data = ""
> > > RowCount = RowCount + 1
> > > Else
> > > Rows(RowCount).Delete
> > > End If
> > > Loop
> > > End Sub
> > >
> > >
> > > "nmpb" wrote:
> > >
> > > > Hi
> > > > I need a program to be able to concate all the rows in B until the cell in
> > > > column A is
> > > > not blank. would also want a separator between them.
> > > > ie row C1 = 000034001570;000034001571;000034001582;000034001589
> > > > C6 = 000034032303
> > > >
> > > > A B
> > > > 1 000034001570 000034001570
> > > > 2 000034001571
> > > > 3 000034001582
> > > > 4 000034001589
> > > > 5 000034001589
> > > > 6 000034032303 000034032303
> > > > 7 000034066598 000034066598
> > > > 8 000034017214 000034017214
> > > > 9 000034017215
> > > > 10 000034019302
> > > > 11 000034019303
> > > >
> > > > The issue is that I have a sheet of over 40,000 rows, also I have noticed
> > > > that I have duplicates in the column B, which will have to be excluded.
> > > > Its been a while since I've done any programming so any help appreciated
> > > >
|