With Statment with for loop

[Raghava@rock]

Hi Team,

Below is the code I am using with "FOR loop to concatenate the value in each row of column 2 ,3,4,5.which is taking long time as I have more than 25000 rows.

while I have searched in google WITH Statement is something that I am thinking to sue to get the task done more quick.

For CurrRow = 13 To CurrLastrow
If Sheets("Curr-wk").Cells(CurrRow, 2).Value <> "" Then
    CurrTEXT = Sheets("Curr-wk").Cells(CurrRow, 2).Value & "$" & Sheets("Curr-wk").Cells(CurrRow, 3).Value & "$" & Sheets("Curr-wk").Cells(CurrRow, 4).Value & "$" & Sheets("Curr-wk").Cells(CurrRow, 5).Value
Sheets("Curr-wk").Cells(CurrRow, 1).Value = CurrTEXT

Else
End If
Next

Could you suggest me how to use with statement in this regard or any improvisation to the above code for fast run time.

Thanks

Mod edit: Code Tags added

 

[Debaser]

You can use arrays to speed this up:

    Dim vDataOut
    Dim vDataIn

    With Sheets("Curr-wk")
        vDataIn = .Range(.Cells(13, 2), .Cells(CurrLastRow, 5)).Value2
        vDataOut = .Range(.Cells(13, 1), .Cells(CurrLastRow, 1)).Value2
    End With
    For CurrRow = LBound(vDataIn, 1) To UBound(vDataIn, 1)
        If vDataIn(CurrRow, 2) <> "" Then
            vDataOut(CurrRow, 1) = vDataIn(CurrRow, 1) & "$" & vDataIn(CurrRow, 2) & "$" & vDataIn(CurrRow, 3) & "$" & vDataIn(CurrRow, 4)
        End If
    Next
    With Sheets("Curr-wk")
        .Range(.Cells(13, 1), .Cells(CurrLastRow, 1)).Value2 = vDataOut
    End With

 

[Raghava@rock]

Thank you so much Debaser, that works

Could you also , provide the array functionality to the below code as well . below code is trying to identify the duplicate value and make them unique.

Dim myDataRng As Range
    Dim cell As Range
 
    Set myDataRng = Range("A13:A" & Cells(Rows.Count, "A").End(xlUp).Row)
        Dum = 1
 
    For Each cell In myDataRng

        ' LOCATE DUPLICATE VALUE(S) IN THE SPECIFIED RANGE OF DATA.
        If Application.Evaluate("COUNTIF(" & myDataRng.Address & "," & cell.Address & ")") > 1 Then
            cell.Offset(0, 0).Value = cell.Offset(0, 0).Value & "$" & "D" & Dum '
          Dum = Dum + 1
        End If
    Next cell
   
    Set myDataRng = Nothing

thanks again for you help in this regard.

Mod edit: Code Tags added

 

[Debaser]

Try this:

    Dim myDataRng             As Range
    Dim n                     As Long
    Dim oDic                  As Object
    Dim vData
    Set myDataRng = Range("A13:A" & Cells(Rows.Count, "A").End(xlUp).Row)
    vData = myDataRng.Value2
    Set oDic = CreateObject("Scripting.Dictionary")
    Dum = 1

    For n = LBound(vData, 1) To UBound(vData, 1)
        If oDic.exists(vData(n, 1)) Then
            vData(n, 1) = vData(n, 1) & "$D" & Dum
            Dum = Dum + 1
        Else
            oDic(vData(n, 1)) = Empty
        End If
    Next n
    myDataRng.Value2 = vData
    Set myDataRng = Nothing

 

[Raghava@rock]

Hey Debaser,
Thanks a lot , this even works better.... however if you provide me some in detail explanation on what Vdata and value 2 & Odic used for that would realy helpfull .

 

[Debaser]

vData is just a variable to hold the array of cell values in.
Value2 is like Value but doesn't return Date or Currency types - it returns the underlying Double precision value instead. It's also therefore a little faster generally.
oDic is a Dictionary object used to hold the unique values from the range.