Optimize loop with an if statement.

[Harshil Mehta]

About the code: It copies sheet7.RangeB11 till the last used column when the word MAPPED is found in sheet7.RangeA11 and so on; paste them in the said destination.

Problem: I have large data set (around 2,00,000 lines) and this code consumes a lot of time when compared to the task implemented manually.

Could any one help me optimize this code?

Sub cf()

Dim lr, lc   As Long

With Sheet7


lr = .Cells(Rows.Count, 1).End(xlUp).Row
For H = 11 To lr
    lc = .Cells(H, Columns.Count).End(xlToLeft).Column
    If .Cells(H, 1) = "Mapped" Or .Cells(H, 1) = "mapped" Then
      .Range(.Cells(H, 2), Cells(H, lc)).Copy
    Sheet3.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

End If

Next


End With
End Sub

 

[Fluff]

How about

Sub HarshilMehta()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long
   
   With Sheet7
      c = .Cells.Find("*", , , , xlByColumns, xlPrevious, , , False).Column
      Ary = .Range("A11", .Range("A" & Rows.Count).End(xlUp)).Resize(, c).Value2
   End With
   ReDim Nary(1 To UBound(Ary), 1 To c - 1)
   For r = 1 To UBound(Ary)
      If LCase(Ary(r, 1)) = "mapped" Then
         nr = nr + 1
         For c = 2 To UBound(Ary, 2)
            Nary(nr, c - 1) = Ary(r, c)
         Next c
      End If
   Next r
   Sheet3.Range("B" & Rows.Count).End(xlUp).Offset(1).Resize(nr, UBound(Nary, 2)).Value = Nary
End Sub

 

[Harshil Mehta]

How about

Sub HarshilMehta()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long
  
   With Sheet7
      c = .Cells.Find("*", , , , xlByColumns, xlPrevious, , , False).Column
      Ary = .Range("A11", .Range("A" & Rows.Count).End(xlUp)).Resize(, c).Value2
   End With
   ReDim Nary(1 To UBound(Ary), 1 To c - 1)
   For r = 1 To UBound(Ary)
      If LCase(Ary(r, 1)) = "mapped" Then
         nr = nr + 1
         For c = 2 To UBound(Ary, 2)
            Nary(nr, c - 1) = Ary(r, c)
         Next c
      End If
   Next r
   Sheet3.Range("B" & Rows.Count).End(xlUp).Offset(1).Resize(nr, UBound(Nary, 2)).Value = Nary
End Sub

This is PERFECT. Thank you so much for your time.

 

[Fluff]

You're welcome & thanks for the feedback.

 

[Harshil Mehta]

How about

Sub HarshilMehta()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long
  
   With Sheet7
      c = .Cells.Find("*", , , , xlByColumns, xlPrevious, , , False).Column
      Ary = .Range("A11", .Range("A" & Rows.Count).End(xlUp)).Resize(, c).Value2
   End With
   ReDim Nary(1 To UBound(Ary), 1 To c - 1)
   For r = 1 To UBound(Ary)
      If LCase(Ary(r, 1)) = "mapped" Then
         nr = nr + 1
         For c = 2 To UBound(Ary, 2)
            Nary(nr, c - 1) = Ary(r, c)
         Next c
      End If
   Next r
   Sheet3.Range("B" & Rows.Count).End(xlUp).Offset(1).Resize(nr, UBound(Nary, 2)).Value = Nary
End Sub

Can we retain the source formatting in the output? For example: my source data contains numbers which are stored as text, however the above code coverts them into numbers in the output. I don't want the code to convert them instead retain the source formatting.