How to change this macro to find last column instead of A to J?

Alex Campbell
Alex Campbell used Ask the Experts™
on
This macro works for columns A to J, creating new rows from items separated by columns in Column G.
I would like it search for last column in the section.
Eventually, I would also like to tell it which column to find the comma separated values used to create new rows


Sub Commas2Rows()
' hiker95, 05/18/2017, ME1006027
Dim lr As Long, r As Long, s, i As Long
Application.ScreenUpdating = False
With ActiveSheet
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  For r = lr To 2 Step -1
    If InStr(.Range("G" & r), ", ") Then
      s = Split(.Range("G" & r), ", ")
      .Rows(r + 1).Resize(UBound(s)).Insert
      .Range("G" & r).Resize(UBound(s) + 1) = Application.Transpose(s)
      .Range("A" & r + 1 & ":F" & r + 1).Resize(UBound(s)).Value = .Range("A" & r & ":F" & r).Value
      .Range("H" & r + 1 & ":J" & r + 1).Resize(UBound(s)).Value = .Range("H" & r & ":J" & r).Value
    End If
  Next r
End With
Application.ScreenUpdating = True
End Sub

Open in new window

Before.jpg
After.jpg
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Test your restores, not your backups...
Top Expert 2016
Commented:
This should do the trick.

Sub Commas2Rows()
  ' hiker95, 05/18/2017, ME1006027
  Dim lr As Long, lc As Long, r As Long, s, i As Long
  Application.ScreenUpdating = False
  With ActiveSheet
    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(.Range("G" & r), ", ") Then
        s = Split(.Range("G" & r), ", ")
        .Rows(r + 1).Resize(UBound(s)).Insert
        .Range("G" & r).Resize(UBound(s) + 1) = Application.Transpose(s)
        .Range("A" & r + 1 & ":F" & r + 1).Resize(UBound(s)).Value = .Range("A" & r & ":F" & r).Value
'        .Range("H" & r + 1 & ":J" & r + 1).Resize(UBound(s)).Value = .Range("H" & r & ":J" & r).Value
        .Range("H" & r + 1 & ":" & Chr(64 + lc) & r + 1).Resize(UBound(s)).Value = .Range("H" & r & ":" & Chr(64 + lc) & r).Value
      End If
    Next r
  End With
  Application.ScreenUpdating = True
End Sub

Open in new window


»bp
With ActiveSheet
   .usedrange
   lc = .usedrange.columns.count + .usedrange.columns.column - 1

Author

Commented:
Thanks, works great

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