Solved: Loop Help

[SBrooky]

Hello
Im trying to figure out a loop that looks at worksheets (stored in an array TLName(1), TLName(2), TLName(3) etc.) at range A2 at first,

• if A2 is blank then look at K2 (offset 0,10) until it has checked column EU

• if A2 is NOT blank then copy A22 to Sheets("Data Review").Range("F5:I5") ((next blank row again))
• Then check if A3 is blank then copy A33 to Sheets("Data Review") etc. until A(whatever row is blank) is blank.

Also if its not blank:

• I want it to put the sheet name (TLName(c)) in the F column on the Data Review sheet.
• Find the sheet name (TLName(c)) in Sheets("Summary").Range("C:C") and return the value in D next to it.
• from the TLName get the Value from A1 and put it in the C column of "Data Review". Or obviously if it has moved to K then K1 etc..

Not clear I know. But im way over my depth here and this is my effort:
[vba]Option Explicit
Sub dataupdate()

Dim ws As Worksheet
Dim TLName(20) As String
Dim i, c, m, l As Integer

i = 1
l = 0
m = 0

For Each ws In ActiveWorkbook.Worksheets

If ws.Name = "Summary" Or _
ws.Name = "Actions Review" Or _
ws.Name = "Statistics" Or _
ws.Name = "Report" Or _
ws.Name = "TODO" Or _
ws.Name = "Data Review" _
Then i = i _
Else: TLName(i) = ws.Name

If ws.Name = "Summary" Or _
ws.Name = "Actions Review" Or _
ws.Name = "Statistics" Or _
ws.Name = "Report" Or _
ws.Name = "TODO" Or _
ws.Name = "Data Review" _
Then i = i _
Else: i = i + 1

Next ws


For c = 1 To i - 1
MsgBox TLName(c)

If ActiveWorkbook.Sheets(TLName(c)).Range("A2").Offset(l, m) = " " Then
l = 0
m = m + 10
Else
Worksheets("Data Review").Activate
Sheets("Data Review").Range("F4:i4").Offset(1, 0).End(xlDown) = Sheets(TLName(c)).Range("A22").Offset(l, m).Value
MsgBox Sheets(TLName(c)).Range("A2").Offset(l, m).Value
l = l + 1

End If
Next c
End Sub
[/vba]

You guys have been awesome so far and I have learnt so much from this forum im very greatful.

[SBrooky]

Ive got a gallery of the different sheets to make it easier for anyone who is willing to help?

http://imgur.com/a/XGdGD

[Teeroy]

While the images helped a sample workbook with dummy data would have been much better.

The loop to feed the worksheets into an array that you loop through again was redundant; it can be done in one pass. I think the following will do what you are after.

[vba]Sub dataupdate()

Dim ws As Worksheet
Dim wsDataDest As Worksheet
Dim rTestCell As Range
Dim rPasteDest As Range
Dim lastRow As Long

Set wsDataDest = Worksheets("Data Review")
Set rPasteDest = wsDataDest.Range("F" & Rows.Count).End(xlUp).Offset(1, 0)
wsDataDest.Activate

For Each ws In ActiveWorkbook.Worksheets
If Not (ws.Name = "Summary" Or _
ws.Name = "Actions Review" Or _
ws.Name = "Statistics" Or _
ws.Name = "Report" Or _
ws.Name = "TODO" Or _
ws.Name = "Data Review") _
Then
Set rTestCell = ws.Range("A2")
lastRow = ws.UsedRange.Cells(ws.UsedRange.Rows.Count, 1).Row
Do
If rTestCell.Value = "" Then
Set rTestCell = rTestCell.Offset(0, 10)
If rTestCell.Column > 150 Then Exit Do
Else
Range(rTestCell, rTestCell.Offset(0, 4)).Copy rPasteDest
Set rPasteDest = rPasteDest.Offset(1, 0)
Set rTestCell = ws.Cells(rTestCell.Row + 1, 1)
End If
Loop Until rTestCell.Row > lastRow
End If
Next
End Sub
[/vba]

[SBrooky]

Perfect! Thanks alot. Thought this thread was dead so thanks for clicking through the next buttons for this =)