This line will not copy the header of the Sheets(MyArr(i)) in the code below.

Range(Cells(1, 1), Cells(1, lcSH)).Copy Sheets("Master").Range("A" & Rows.Count).End(xlUp)(1) - or with the (2)

In a snippet run in the sheet module the line works fine.

Note that if it is the first time the code runs, I want the header to copy to row 1 on Master sheet and the FoundWk entries to copy directly below that header.

I believe I have the code set to provide a blank row for each time the code is run so there will be a header copy and a number of entries directly following. Then when run again, a blank row then a header copy and a number of entries directly following. (Can't get the header to copy so that has not been verified)

So on the Master I would have starting in row 1:

Header
entry
entry
entry

Header
entry
entry
entry
entry
entry

Header
entry
entry

Thanks,
Howard

Sub WeeklyReader()
Dim c As Range
Dim i As Long
Dim MyArr As Variant
Dim lrSH As Long, lcSH As Long
Dim FoundWk As Range
Dim aWeek As Variant

aWeek = InputBox("Enter the WEEK to search for")

If aWeek = "" Then
Exit Sub
ElseIf IsNumeric(aWeek) Then
aWeek = Val(aWeek) '/ converts a "text" number to a value
Else
'/ is text and that is okay
End If

MyArr = Array("Bodypump", "Spinning", "Zumba")

Application.ScreenUpdating = False

For i = LBound(MyArr) To UBound(MyArr)

With Sheets(MyArr(i))

lrSH = .Cells(Rows.Count, 1).End(xlUp).Row
lcSH = .Cells.Find(What:="*", after:=[A1], _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column

Set FoundWk = .Range("A2:A" & lrSH).Find(What:=aWeek, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)

If Not FoundWk Is Nothing Then
If Sheets("Master").Range("A" & Rows.Count).End(xlUp).Row = 1 Then
Range(Cells(1, 1), Cells(1, lcSH)).Copy Sheets("Master").Range("A" & Rows.Count).End(xlUp)(1)
FoundWk.Resize(1, lcSH).Copy Sheets("Master").Range("A" & Rows.Count).End(xlUp)(2)
Else
Range(Cells(1, 1), Cells(1, lcSH)).Copy Sheets("Master").Range("A" & Rows.Count).End(xlUp)(3)
FoundWk.Resize(1, lcSH).Copy Sheets("Master").Range("A" & Rows.Count).End(xlUp)(2)
End If
End If

End With
Next 'i

Application.ScreenUpdating = True
End Sub

Your code refs the active sheet in the "If Not FoundWk Is Nothing Then"
block. I suspect the copy ranges are on Sheets(MyArr(i)) and so require
dots!

If what you're trying to do is grab blocks of data under week headings,
it could be done a lot easier. Why don't you post a link to the file so
we can see how the 3 source sheets are laid out for each week's data!

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

On Friday, March 6, 2015 at 10:27:40 PM UTC-8, GS wrote:
Your code refs the active sheet in the "If Not FoundWk Is Nothing Then"
block. I suspect the copy ranges are on Sheets(MyArr(i)) and so require
dots!

If what you're trying to do is grab blocks of data under week headings,
it could be done a lot easier. Why don't you post a link to the file so
we can see how the 3 source sheets are laid out for each week's data!

--
Garry



https://www.dropbox.com/s/tp18r9bnj7...heet.xlsm?dl=0

It is not really blocks of data but rather a header and a single line from multiple sheets, using the three here, but once code is correct, probably will be a few more.

When another search is made, there needs to be a blank row space between them.

The data on the search sheets will vary in number of columns between sheets. I am trying to accommodate varied row lengths within each sheet with this - note the column number variable "lcSH" in this copy line.

Range(Cells(1, 1), Cells(1, lcSH)).Copy

Howard

Woops-- I do believe I misstated how the data should appear in Master sheet.

If you were to enter WEEK 3 in the inputbox it should look like this on Master.

With the sheet it may make be a bit clearer, did not copy here very well aligned.


Worksheet "MASTER"
A B C D E F
1 BODYPUMP 9AM MON 6PM MON 2PM TUES 5AM WED
2 WEEK 3 EVA KAREN WENDY EVA
3
4 SPINNING 10AM MON 2PM TUES 4PM FRI
5 WEEK 3 EVA KAREN WENDY
6
7 ZUMBA 8AM MON 2PM TUES 11AM WED 10AM THURS 9AM SAT
8 WEEK 3 JIM EVA SARAH ALLISON KAREN

Howard

Hi Howard,

Am Fri, 6 Mar 2015 23:00:16 -0800 (PST) schrieb L. Howard:

If you were to enter WEEK 3 in the inputbox it should look like this on Master.

how does sheet Master look like? Are there more than one row of data for
each exercise? Can times change from week to week and must they also be
copied?
If not, have a look:
https://onedrive.live.com/?cid=9378A...121822A3%21326
for "Tester WEEK"
I created names for the exercises and call the range with this name.


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Hi Howard,

Am Sat, 7 Mar 2015 08:36:18 +0100 schrieb Claus Busch:

https://onedrive.live.com/?cid=9378A...121822A3%21326
for "Tester WEEK"

please ignore that post.


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Hi Howard,

Am Fri, 6 Mar 2015 22:49:07 -0800 (PST) schrieb L. Howard:

https://www.dropbox.com/s/tp18r9bnj7...heet.xlsm?dl=0

try it this way:

Sub WeeklyReader2()
Dim aWeek As Long, LRow As Long, i As Long
Dim myArr As Variant
Dim c As Range, myRng As Range


aWeek = Application.InputBox("Enter the WEEK to search for",
"Weeknumber", Type:=1)
Sheets("Master").UsedRange.ClearContents
If aWeek = False Then Exit Sub

myArr = Array("Bodypump", "Spinning", "Zumba")

Application.ScreenUpdating = False

For i = 0 To UBound(myArr)
Set myRng = Nothing
With Sheets(myArr(i))
Set c = .Range("A1:A100").Find(aWeek, LookIn:=xlValues,
lookat:=xlPart)
If Not c Is Nothing Then
LRow = Sheets("Master").Cells(Rows.Count, 1).End(xlUp).Row
If LRow = 1 Then
Set myRng = Union(.Rows(1), .Rows(c.Row))
myRng.Copy Sheets("Master").Range("A1")
Else
Set myRng = Union(.Rows(1), .Rows(c.Row))
myRng.Copy Sheets("Master").Cells(LRow + 2, 1)
End If
End If
End With
Next
Sheets("Master").Columns("A:F").AutoFit
Application.ScreenUpdating = True
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Try...

Sub GetWeekInfo()
Dim vName, vAns, lRow&, wk&, sMsg$
Dim wksTarget As Worksheet, rng As Range

Const sSheetNames$ = "Bodypump,Spinning,Zumba"

sMsg = "Enter a week number to find"
wk = Application.InputBox(sMsg, "Find Week Info", Type:=1)
If wk = False Then Exit Sub

Set wksTarget = ThisWorkbook.Sheets("Master")
'Do we Reset wksTarfet OR Append new data?
sMsg = "Do you want to reset " & wksTarget.Name _
& ", or append new data?" & vbLf & vbLf _
& "Answer YES to clear existing data, NO to append new data."
vAns = MsgBox(sMsg, vbYesNo, "Reset Master Sheet")
If vAns = vbYes Then wksTarget.UsedRange.ClearContents

Application.ScreenUpdating = False
For Each vName In Split(sSheetNames, ",")
With Sheets(vName)
Set rng = .Columns(1).Find(wk, LookIn:=xlValues, lookat:=xlPart)
If Not rng Is Nothing Then
lRow = wksTarget.Cells(wksTarget.Rows.Count, 1).End(xlUp).Row
lRow = IIf(lRow = 1, lRow, lRow + 2) '//reset or append
Set rng = Union(.Rows(1), .Rows(rng.Row))
rng.Copy wksTarget.Cells(lRow, 1)
End If 'Not rng Is Nothing
End With 'Sheets(vName)
Next 'vName

Application.ScreenUpdating = True
Set wksTarget = Nothing: Set rng = Nothing
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Typo...

Sub GetWeekInfo()
Dim vName, vAns, lRow&, wk&, sMsg$
Dim wksTarget As Worksheet, rng As Range

Const sSheetNames$ = "Bodypump,Spinning,Zumba"

sMsg = "Enter a week number to find"
wk = Application.InputBox(sMsg, "Find Week Info", Type:=1)
If wk = False Then Exit Sub

Set wksTarget = ThisWorkbook.Sheets("Master")
'Do we Reset wksTarget OR Append new data?
sMsg = "Do you want to reset " & wksTarget.Name _
& ", or append new data?" & vbLf & vbLf _
& "Answer YES to clear existing data, NO to append new data."
vAns = MsgBox(sMsg, vbYesNo, "Reset Master Sheet")
If vAns = vbYes Then wksTarget.UsedRange.ClearContents

Application.ScreenUpdating = False
For Each vName In Split(sSheetNames, ",")
With Sheets(vName)
Set rng = .Columns(1).Find(wk, LookIn:=xlValues,
lookat:=xlPart)
If Not rng Is Nothing Then
lRow = wksTarget.Cells(wksTarget.Rows.Count, 1).End(xlUp).Row
lRow = IIf(lRow = 1, lRow, lRow + 2) '//reset or append
Set rng = Union(.Rows(1), .Rows(rng.Row))
rng.Copy wksTarget.Cells(lRow, 1)
End If 'Not rng Is Nothing
End With 'Sheets(vName)
Next 'vName

Application.ScreenUpdating = True
Set wksTarget = Nothing: Set rng = Nothing
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion