Non Looping For Next Loop

[tlchan]

Hi there,

I have a data sheets with all raw data. The extraction of data based on currency in Column A and copy the the required data to the respective currency tab. The for next statement only working for the 1st found item only. Can anyone repair the error in the coding per test file attached.


Thanks

[Paul_Hossler]

I think you'll get closer without the 2 lines marked with a ---------------------

You keep reseting LRDest

Option Explicit

Sub FCLedger()

    Dim WSFCData As Worksheet
    Dim WS As Worksheet
    Dim LRData As Long
    Dim LRDest As Long
    Dim i As Long
    Dim FCname As Range
    Dim shtName As String
    
    Set WSFCData = Worksheets("Txn Data")
    
    With WSFCData
        LRData = .Cells(.Rows.Count, "A").End(xlUp).Row
      
        For i = 2 To LRData
           'If .Range("A2:A" & i) = shtName Then
           For Each FCname In .Cells(i, 1)
               shtName = FCname.Text
               Set WS = Worksheets(shtName)
    
               LRDest = WS.Cells(.Rows.Count, "A").End(xlUp).Row + 1
'--------               LRDest = 4
               WS.Range("A4:J" & LRDest).Clear
    
                Sheets(shtName).Range("A" & LRDest) = .Range("A" & i).Value
               ' WSUSD.Range("A" & LRUSD) = .Range("A" & i)
                Sheets(shtName).Range("B" & LRDest) = .Range("B" & i).Value
                Sheets(shtName).Range("C" & LRDest) = .Range("C" & i)
                'WSUSD.Range("C" & LRUSD) = .Range("N" & i)
                'WSUSD.Range("G" & LRUSD) = .Range("C" & i)
                'WSUSD.Range("D" & LRUSD) = .Range("D" & i)
                'WSUSD.Range("E" & LRUSD) = .Range("F" & i)
                'WSUSD.Range("G" & LRUSD) = .Range("H" & i)
                'WSUSD.Range("H" & LRUSD) = .Range("E" & i)
               ' WSUSD.Range("I" & LRUSD) = .Range("G" & i)
               ' WSUSD.Range("K" & LRUSD) = .Range("L" & i)
               ' WSUSD.Range("F4").Formula = "=sum(F3+D4-E4)"
                'WSUSD.Range("J4").Formula = "=sum(J3+H4-I4+K4)"
                
'---------                LRDest = LRDest + 1
           Next
       Next
        'WSUSD.Range("F4:F" & LRUSD - 1).FillDown
        'WSUSD.Range("J4:J" & LRUSD - 1).FillDown
        'WS.Range("B4:B" & LRDest - 1) = Format(Date, "dd-mmm-yy")
        
         Sheets(shtName).Range("B4:B" & LRDest - 1) = Format(Date, "dd-mmm-yy")
    End With
End Sub

[tlchan]

I think you'll get closer without the 2 lines marked with a ---------------------

You keep reseting LRDest

Option Explicit

Sub FCLedger()

    Dim WSFCData As Worksheet
    Dim WS As Worksheet
    Dim LRData As Long
    Dim LRDest As Long
    Dim i As Long
    Dim FCname As Range
    Dim shtName As String
    
    Set WSFCData = Worksheets("Txn Data")
    
    With WSFCData
        LRData = .Cells(.Rows.Count, "A").End(xlUp).Row
      
        For i = 2 To LRData
           'If .Range("A2:A" & i) = shtName Then
           For Each FCname In .Cells(i, 1)
               shtName = FCname.Text
               Set WS = Worksheets(shtName)
    
               LRDest = WS.Cells(.Rows.Count, "A").End(xlUp).Row + 1
'--------               LRDest = 4
               WS.Range("A4:J" & LRDest).Clear
    
                Sheets(shtName).Range("A" & LRDest) = .Range("A" & i).Value
               ' WSUSD.Range("A" & LRUSD) = .Range("A" & i)
                Sheets(shtName).Range("B" & LRDest) = .Range("B" & i).Value
                Sheets(shtName).Range("C" & LRDest) = .Range("C" & i)
                'WSUSD.Range("C" & LRUSD) = .Range("N" & i)
                'WSUSD.Range("G" & LRUSD) = .Range("C" & i)
                'WSUSD.Range("D" & LRUSD) = .Range("D" & i)
                'WSUSD.Range("E" & LRUSD) = .Range("F" & i)
                'WSUSD.Range("G" & LRUSD) = .Range("H" & i)
                'WSUSD.Range("H" & LRUSD) = .Range("E" & i)
               ' WSUSD.Range("I" & LRUSD) = .Range("G" & i)
               ' WSUSD.Range("K" & LRUSD) = .Range("L" & i)
               ' WSUSD.Range("F4").Formula = "=sum(F3+D4-E4)"
                'WSUSD.Range("J4").Formula = "=sum(J3+H4-I4+K4)"
                
'---------                LRDest = LRDest + 1
           Next
       Next
        'WSUSD.Range("F4:F" & LRUSD - 1).FillDown
        'WSUSD.Range("J4:J" & LRUSD - 1).FillDown
        'WS.Range("B4:B" & LRDest - 1) = Format(Date, "dd-mmm-yy")
        
         Sheets(shtName).Range("B4:B" & LRDest - 1) = Format(Date, "dd-mmm-yy")
    End With
End Sub

[tlchan]

I had tried remove the mentioned 2 lines but still not avail.