For Each c In Range... is slow

Giganews Newsgroups
Subject: For Each c In Range... is slow
Posted by:  L. Howard (lhkitt…
Date: Sat, 26 Sep 2015

This works but is a bit clunky and a little slow.

With sheet Reg:
Columns A, B, C is Name, Info1, Info2 (a person & two info bits per row)
Columns D, E, F, G, H, I are Sheet1, Sheet2, Sheet3 etc. actual sheet names in the workbook, just using six here, could be ~15.

If any of the cells in the Sheet Name Header columns have an "X" then the column A, B, C data on that row is copied to the sheet named in the Header of that column.

I have set OneRng to include D2 to I- as far down as column A info goes.
Then a For Each / Next offsetting from each "X" to copy the A B C info of that row and paste in the sheet name of that column.

I'm guessing the search method for looking across the OneRng is not very efficient using this approach.

Got a smoother idea, please?


Sub Header_Sheet()
Dim OneRng As Range
Dim sheetTo As String
Dim c As Range
Dim aRow As Long, aCol As Long

Set OneRng = Sheets("Reg").Range("D2:I" & Cells(Rows.Count, "A").End(xlUp).Row)
Application.ScreenUpdating = False

For Each c In OneRng
  aRow = c.Row - 1
  aCol = c.Column - 1

  sheetTo = c.Offset(-aRow, 0).Value

  If c = "X" Then
    c.Offset(, -aCol).Resize(1, 3).Copy Sheets(sheetTo).Range("A" & Rows.Count).End(xlUp)(2)
  End If

Next 'c
Application.ScreenUpdating = True
End Sub