-
Solved: Loop Help
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 A2:D2 to Sheets("Data Review").Range("F5:I5") ((next blank row again))
- Then check if A3 is blank then copy A3:D3 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("A2:D2").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.
-
Ive got a gallery of the different sheets to make it easier for anyone who is willing to help?
http://imgur.com/a/XGdGD
-
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]
-
Perfect! Thanks alot. Thought this thread was dead so thanks for clicking through the next buttons for this =)