How to make this macro create a new sheet and leave the original sheet alone?

Alex Campbell
Alex Campbell used Ask the Experts™
on
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Bill PrewIT / Software Engineering Consultant
Top Expert 2016

Commented:
Sure, can you provide a sample workbook for testing.


»bp
IT / Software Engineering Consultant
Top Expert 2016
Commented:
Give this a try, should insert a new sheet at the beginning of the workbook and do the spilts there...

Sub Commas2Rows()
  Dim lr As Long, lc As Long, r As Long, s, i As Long, SplitCol As String, SplitBefore As String, SplitAfter As String, NewSheet As Worksheet

  SplitCol = Application.InputBox("Please specify column letter to split on:", "Split Column", "G")
  SplitBefore = Chr(Asc(SplitCol) - 1)
  SplitAfter = Chr(Asc(SplitCol) + 1)

  With ActiveWorkbook
    .ActiveSheet.Copy Before:=.Worksheets(1)
    Set NewSheet = .Worksheets(1)
  End With
  
  Application.ScreenUpdating = False

  With NewSheet
    lr = .Cells(Rows.Count, 1).End(xlUp).Row
    lc = .Cells(2, Columns.Count).End(xlToLeft).Column

    For r = lr To 2 Step -1
      If InStr(.Cells(r, SplitCol), ", ") Then
        s = Split(.Cells(r, SplitCol), ", ")
        .Rows(r + 1).Resize(UBound(s)).Insert
        .Cells(r, SplitCol).Resize(UBound(s) + 1) = Application.Transpose(s)
        .Range(.Cells(r + 1, 1), .Cells(r + 1, SplitBefore)).Resize(UBound(s)).Value = .Range(.Cells(r, 1), .Cells(r, SplitBefore)).Value
        .Range(.Cells(r + 1, SplitAfter), .Cells(r + 1, lc)).Resize(UBound(s)).Value = .Range(.Cells(r, SplitAfter), .Cells(r, lc)).Value
      End If
    Next r
  End With

  Application.ScreenUpdating = True
End Sub

Open in new window


»bp

Author

Commented:
Thanks, works great.
Bill PrewIT / Software Engineering Consultant
Top Expert 2016

Commented:
Great, glad that helped, thanks for the feedback.


»bp

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial