tweak existing code

[Jaz05]

Hi guru's,

I have a code, which does me well. Where "Data" column L has the GL account # 10346500 it takes some cell values from source sheet row and copies it into "OPLOSS" sheet. It copies the data from msSourceColumns to my Target sheet, but puts the data in columns A,B,C,D,E respectively.

I need to tweak the code so the target sheet "OPLOSS" values are in column U,M,W,C,D
in the last row (not A,B,C,D,E).

I've tried to play with it by creating Const msTargetColumns As String = ,U,M,W,C,Dand adding some additional Dim
but was failing at wsTo.Range
----------------------------------------------------------



Option Explicit
Const msEventColumn As String = "L"
Const msSourceColumns As String = ",A,D,E,L,E,"
Sub CopyData()
Dim iPtr As Integer
Dim lTargetRow As Long
Dim rCur As Range
Dim sFirstAddress As String
Dim saSourceCols() As String
Dim vaData() As Variant
Dim wsFrom As Worksheet, wsTo As Worksheet

Set wsFrom = Sheets("Data")
Set wsTo = Sheets("OPLOSS")
lTargetRow = wsTo.Cells(Rows.Count, "A").End(xlUp).Row

saSourceCols = Split(msSourceColumns, ",")
ReDim vaData(1 To 1, 1 To UBound(saSourceCols))
With wsFrom.Columns(msEventColumn)
Set rCur = .Find("10346500", LookIn:=xlValues)
If Not rCur Is Nothing Then
sFirstAddress = rCur.Address
Do
For iPtr = 1 To UBound(saSourceCols)
vaData(1, iPtr) = wsFrom.Cells(rCur.Row, saSourceCols(iPtr)).Value
Next iPtr
lTargetRow = lTargetRow + 1
wsTo.Range("A" & lTargetRow, Cells(lTargetRow, UBound(vaData, 2)).Address).Value = vaData
Set rCur = .FindNext(rCur)
If rCur Is Nothing Then Exit Do
Loop While rCur.Address <> sFirstAddress
End If
End With

End Sub

 

[AlphaFrog]

Try something like this...

Wasn't sure how you wanted to determine the first target row on OPLOSS

Option Explicit
Sub CopyData()

    Dim iPtr   As Integer
    Dim lTargetRow As Long
    Dim rCur   As Range
    Dim sFirstAddress As String
    Dim saSourceCols As Variant
    Dim saTargetCols As Variant
    Dim wsFrom As Worksheet, wsTo As Worksheet
    
    Const msEventColumn As String = "L"
[COLOR="Blue"]    saSourceCols = Array("A", "D", "E", "L", "E")
    saTargetCols = Array("U", "M", "W", "C", "D")[/COLOR]
    Set wsFrom = Sheets("Data")
    Set wsTo = Sheets("OPLOSS")
    [COLOR="Red"]lTargetRow = wsTo.Cells(Rows.Count, "A").End(xlUp).Row + 1[/COLOR]
    
    Application.ScreenUpdating = False
    With wsFrom.Columns(msEventColumn)
        Set rCur = .Find("10346500", LookIn:=xlValues)
        If Not rCur Is Nothing Then
            sFirstAddress = rCur.Address
            Do
                For iPtr = LBound(saSourceCols) To UBound(saSourceCols)
                    wsTo.Range(saTargetCols(iPtr) & lTargetRow).Value = _
                        wsFrom.Range(saSourceCols(iPtr) & rCur.Row).Value
                Next iPtr
                lTargetRow = lTargetRow + 1
                Set rCur = .FindNext(rCur)
            Loop While rCur.Address <> sFirstAddress
        End If
    End With
    Application.ScreenUpdating = True

End Sub

 

[Jaz05]

Thanks AlphaFrog.
Friday night here, so I'll test this Monday, but reading your additions, I think this will work.

Thank you.