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.