Hi,
Is there anyway to stop the below code producing duplicates?
If ComboBox1.Value = "Users" Then
'USER BREAKDOWN
userLR = Range("J" & Rows.Count).End(xlUp).Row
userLC = Cells(1, Columns.Count).End(xlToLeft).Column
Columns("K").Insert
For useri = userLR To 1 Step -1
With Range("J" & useri)
If InStr(.Value, "; ") = 0 Then
.Value = .Value
Else
userX = Split(.Value, "; ")
.Offset(1).Resize(UBound(userX)).EntireRow.Insert
.Resize(UBound(userX) - LBound(userX) + 1).Value = Application.Transpose(userX)
End If
End With
Next useri
Columns("K").Delete
userLR = Range("J" & Rows.Count).End(xlUp).Row
With Range(Cells(1, 1), Cells(userLR, userLC))
On Error Resume Next
.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
On Error GoTo 0
.Value = .Value
End With
'Product breakdown
LR = Range("C" & Rows.Count).End(xlUp).Row
LC = Cells(1, Columns.Count).End(xlToLeft).Column
Columns("D").Insert
For i = LR To 1 Step -1
With Range("C" & i)
If InStr(.Value, "; ") = 0 Then
.Value = .Value
Else
X = Split(.Value, "; ")
.Offset(1).Resize(UBound(X)).EntireRow.Insert
.Resize(UBound(X) - LBound(X) + 1).Value = Application.Transpose(X)
End If
End With
Next i
Columns("D").Delete
LR = Range("C" & Rows.Count).End(xlUp).Row
With Range(Cells(1, 1), Cells(LR, LC))
On Error Resume Next
.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
On Error GoTo 0
.Value = .Value
End With
End If
Any help greatly appreciated
Bookmarks