Code to copy header does not copy
 

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

Code to copy header does not copy
 

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

Code to copy header does not copy
 

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

Code to copy header does not copy
 

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

Code to copy header does not copy
 

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

Code to copy header does not copy
 

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

Code to copy header does not copy
 

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

Code to copy header does not copy
 

On Friday, March 6, 2015 at 11:44:52 PM UTC-8, Claus Busch wrote:
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.
--

Hi Claus,

If you search for WEEK 3 then code should return Row 1 and the row of WEEK 3 for each sheet that has a WEEK 3.

With a blank row between each.

So with the workbook if you search WEEK 3, it should return Spinner sheet row 1 and row 4 and for Zumba sheet it should return row 1 and row 4.

With a space between the sheets returns.

If the search was for WEEK 1 then row 1 and row 2 for sheets Bodypump, Spinner and Zumba again with a space between each sheets return.

(I have a "12345" on sheet Spinner, I was testing and forgot to change it back)

Howard

Code to copy header does not copy
 

Hi Howard,

Am Sat, 7 Mar 2015 00:22:44 -0800 (PST) schrieb L. Howard:

If you search for WEEK 3 then code should return Row 1 and the row of WEEK 3 for each sheet that has a WEEK 3.

With a blank row between each.

now I know that. But before one hour I still had not enough coffee and
so I wrote code and uploaded the file and then I read your question. I
thought you enter data in Master and then distribute data to the
different sheets.
In my last answer I revised my mistake.


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

Code to copy header does not copy
 

On Saturday, March 7, 2015 at 12:29:23 AM UTC-8, Claus Busch wrote:
Hi Howard,

Am Sat, 7 Mar 2015 00:22:44 -0800 (PST) schrieb L. Howard:

If you search for WEEK 3 then code should return Row 1 and the row of WEEK 3 for each sheet that has a WEEK 3.

With a blank row between each.

now I know that. But before one hour I still had not enough coffee and
so I wrote code and uploaded the file and then I read your question. I
thought you enter data in Master and then distribute data to the
different sheets.
In my last answer I revised my mistake.


Regards
Claus B.
--


Thanks Claus,

Sub WeeklyReader2() - really works well, and brings up a question I had not thought of.

I was assuming, if you searched WEEK 3 and the data shows up on Master correctly as it does, then if you searched WEEK 2 then that data would list BELOW the current data on Master.

I am thinking that is preferred. In the short time I looked at the code I was puzzled about how to make that happen along with starting in row 1 when the Master sheet is blank.

Also, at this point, I am thinking that week numbers will be the same row on each sheet so the method of entering the week number instead of a string like
"WEEK 2" should be fine. If not I will tinker with it, but might as well leave it as is.

Howard

Code to copy header does not copy
 

Hi Howard,

Am Sat, 7 Mar 2015 00:47:42 -0800 (PST) schrieb L. Howard:

I was assuming, if you searched WEEK 3 and the data shows up on Master correctly as it does, then if you searched WEEK 2 then that data would list BELOW the current data on Master.

I am thinking that is preferred. In the short time I looked at the code I was puzzled about how to make that happen along with starting in row 1 when the Master sheet is blank.

you only have to delete:
Sheets("Master").UsedRange.ClearContents

But then the user has to clear Master manually.
Or you create another button to clear contents


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

Code to copy header does not copy
 

Hi Howard,

Am Sat, 7 Mar 2015 00:47:42 -0800 (PST) schrieb L. Howard:

I was assuming, if you searched WEEK 3 and the data shows up on Master correctly as it does, then if you searched WEEK 2 then that data would list BELOW the current data on Master.

or try it this way:
With an input box you can choose if you want do clear Master

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

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

Start:
myDel = Application.InputBox("Do you want to clear sheet Master? Y/N",
"Clear Contents?", Type:=2)
If myDel = "Y" Then
Sheets("Master").UsedRange.ClearContents
ElseIf myDel = "" Or myDel = "False" Then
MsgBox "Please enter Y or N"
GoTo Start
End If

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

Or look again in OneDrive


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

Code to copy header does not copy
 

you only have to delete:
Sheets("Master").UsedRange.ClearContents

But then the user has to clear Master manually.
Or you create another button to clear contents


Regards
Claus B.

Aha! Looking good. With the weekend, the jury may not come back before Monday.

Appreciate the help very much.

I was working with UNION on another project, but have not seen it used as you have here. That will take a bit of study.

Howard

Code to copy header does not copy
 

or try it this way:
With an input box you can choose if you want do clear Master

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

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

Start:
myDel = Application.InputBox("Do you want to clear sheet Master? Y/N",
"Clear Contents?", Type:=2)
If myDel = "Y" Then
Sheets("Master").UsedRange.ClearContents
ElseIf myDel = "" Or myDel = "False" Then
MsgBox "Please enter Y or N"
GoTo Start
End If

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

Or look again in OneDrive


Regards
Claus B.


Very good!

Way late here , will resume tomorrow.

Thanks.

Howard

Code to copy header does not copy
 

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

Code to copy header does not copy
 

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