I have this code that I want to modify to change instead of the "v= Array
(given names) I want to look for a check mark in column B of worksheet
"data". If there is a check mark then take the name from column A and goto
the portion of the code (For i = ) if not then next untill a blank cell is
reached columm A in worksheet "Data"

What I am trying to accomplish is to make this code more selective in the
names of the people I want to get data from. At this point the way the code
is now, I only have the option of getting the reports for the names listed in
the lines v=Array.

Here is the code I currently have and want to change this is in excel 2003:

Sub RecapReport()

Sheets("Recap Report").Select
Dim v As Variant, bk As Workbook, sh As Worksheet, ws As Worksheet
Dim bk1 As Workbook, sh1 As Worksheet
Dim sn As String, sm As String, sl As String, i As Long
Dim rng1 As Range, rng As Range
Dim rng2 As Range
Set bk = Workbooks("Recaps08.xls")
Set sh = bk.Worksheets("Data")
Set ws = bk.Worksheets("Recap Report")
sn = LCase(sh.Range("C3").Value)
sm = sh.Range("C4").Value
sl = sh.Range("C5").Value
If sn = "all" Then
v = Array("Tony Sarullo " & sl & ".xls", "John Mudaro " & sl & ".xls", "Ron
Ficarelli " & sl & ".xls")
Else
v = Array(sn & " " & sl)
End If
For i = LBound(v) To UBound(v)
Set bk1 = Workbooks.Open("C:\Service Recaps\" & v(i))
Set sh1 = bk1.Worksheets(sm)
If i = LBound(v) Then
Set rng1 = ws.Range(ws.Range("A7"), ws.Cells(Rows.Count, 1).End(xlUp))
rng1.EntireRow.Delete
Set rng = ws.Range("A7")
Else
Set rng = ws.Cells(Rows.Count, 1).End(xlUp)(2)
End If
Set rng2 = sh1.Range(sh1.Range("A9"), _
sh1.Cells(Rows.Count, 1).End(xlUp)).EntireRow
rng2.Copy Destination:=rng
bk1.Close SaveChanges:=False
Next
'LastRow = Range("A65536").End(xlUp).Row
Application.Run "SortReport"
Application.Run "Addtotals"
End Sub

ihopesomeonecanhelpyouandidon'tmeantobemeanbuttryi ngtoreadyourcodeisliketryingtoreadawholeparagraphw ithoutasinglespaceinbetweenthewords.

spaces and indents would be helpful.
:)
now, is the checkmark a checkbox from the control toolbox or forms
toolbar, or is it a font character?
susan


On Dec 5, 10:34*am, ParTeeGolfer
wrote:
I have this code that I want to modify to change instead of the "v= Array
(given names) I want to look for a check mark in column B of worksheet
"data". If there is a check mark then take the name from column A and goto
the portion of the code (For i = ) if not then next untill a blank cell is
reached columm A in worksheet "Data"

What I am trying to accomplish is to make this code more selective in the
names of the people I want to get data from. At this point the way the code
is now, I only have the option of getting the reports for the names listed in
the lines v=Array.

Here is the code I currently have and want to change this is in excel 2003:

Sub RecapReport()

Sheets("Recap Report").Select
Dim v As Variant, bk As Workbook, sh As Worksheet, ws As Worksheet
Dim bk1 As Workbook, sh1 As Worksheet
Dim sn As String, sm As String, sl As String, i As Long
Dim rng1 As Range, rng As Range
Dim rng2 As Range
Set bk = Workbooks("Recaps08.xls")
Set sh = bk.Worksheets("Data")
Set ws = bk.Worksheets("Recap Report")
sn = LCase(sh.Range("C3").Value)
sm = sh.Range("C4").Value
sl = sh.Range("C5").Value
If sn = "all" Then
v = Array("Tony Sarullo " & sl & ".xls", "John Mudaro " & sl & ".xls", "Ron
Ficarelli " & sl & ".xls")
Else
v = Array(sn & " " & sl)
End If
For i = LBound(v) To UBound(v)
Set bk1 = Workbooks.Open("C:\Service Recaps\" & v(i))
Set sh1 = bk1.Worksheets(sm)
If i = LBound(v) Then
Set rng1 = ws.Range(ws.Range("A7"), ws.Cells(Rows.Count, 1).End(xlUp))
rng1.EntireRow.Delete
Set rng = ws.Range("A7")
Else
Set rng = ws.Cells(Rows.Count, 1).End(xlUp)(2)
End If
Set rng2 = sh1.Range(sh1.Range("A9"), _
sh1.Cells(Rows.Count, 1).End(xlUp)).EntireRow
rng2.Copy Destination:=rng
bk1.Close SaveChanges:=False
Next
'LastRow = Range("A65536").End(xlUp).Row
Application.Run "SortReport"
Application.Run "Addtotals"
End Sub

Sorry about the code, it was copied and pasted the way I wrote itfrom my
workbook. The checkmark is in the format of a font as an "x"

"Susan" wrote:

ihopesomeonecanhelpyouandidon'tmeantobemeanbuttryi ngtoreadyourcodeisliketryingtoreadawholeparagraphw ithoutasinglespaceinbetweenthewords.

spaces and indents would be helpful.
:)
now, is the checkmark a checkbox from the control toolbox or forms
toolbar, or is it a font character?
susan


On Dec 5, 10:34 am, ParTeeGolfer
wrote:
I have this code that I want to modify to change instead of the "v= Array
(given names) I want to look for a check mark in column B of worksheet
"data". If there is a check mark then take the name from column A and goto
the portion of the code (For i = ) if not then next untill a blank cell is
reached columm A in worksheet "Data"

What I am trying to accomplish is to make this code more selective in the
names of the people I want to get data from. At this point the way the code
is now, I only have the option of getting the reports for the names listed in
the lines v=Array.

Here is the code I currently have and want to change this is in excel 2003:

Sub RecapReport()

Sheets("Recap Report").Select
Dim v As Variant, bk As Workbook, sh As Worksheet, ws As Worksheet
Dim bk1 As Workbook, sh1 As Worksheet
Dim sn As String, sm As String, sl As String, i As Long
Dim rng1 As Range, rng As Range
Dim rng2 As Range
Set bk = Workbooks("Recaps08.xls")
Set sh = bk.Worksheets("Data")
Set ws = bk.Worksheets("Recap Report")
sn = LCase(sh.Range("C3").Value)
sm = sh.Range("C4").Value
sl = sh.Range("C5").Value
If sn = "all" Then
v = Array("Tony Sarullo " & sl & ".xls", "John Mudaro " & sl & ".xls", "Ron
Ficarelli " & sl & ".xls")
Else
v = Array(sn & " " & sl)
End If
For i = LBound(v) To UBound(v)
Set bk1 = Workbooks.Open("C:\Service Recaps\" & v(i))
Set sh1 = bk1.Worksheets(sm)
If i = LBound(v) Then
Set rng1 = ws.Range(ws.Range("A7"), ws.Cells(Rows.Count, 1).End(xlUp))
rng1.EntireRow.Delete
Set rng = ws.Range("A7")
Else
Set rng = ws.Cells(Rows.Count, 1).End(xlUp)(2)
End If
Set rng2 = sh1.Range(sh1.Range("A9"), _
sh1.Cells(Rows.Count, 1).End(xlUp)).EntireRow
rng2.Copy Destination:=rng
bk1.Close SaveChanges:=False
Next
'LastRow = Range("A65536").End(xlUp).Row
Application.Run "SortReport"
Application.Run "Addtotals"
End Sub

:)
ok...........
try this:
'================================
Sub RecapReport()

Sheets("Recap Report").Select

Dim v As Variant, bk As Workbook, sh As Worksheet, ws As Worksheet
Dim bk1 As Workbook, sh1 As Worksheet
Dim sn As String, sm As String, sl As String, i As Long
Dim rng1 As Range, rng As Range
Dim rng2 As Range

Dim myLastRow as long
Dim rng3 as Range
Dim c as Range

Set bk = Workbooks("Recaps08.xls")
Set sh = bk.Worksheets("Data")
Set ws = bk.Worksheets("Recap Report")

sn = LCase(sh.Range("C3").Value)
sm = sh.Range("C4").Value
sl = sh.Range("C5").Value

myLastRow = sh.cells(10000,2).end(xlup).row
set rng3 = sh.range("b1:b" & mylastrow)

For Each c in rng3
if c.value = "x" and c.offset(0,-1).value = "" then

For i = LBound(v) To UBound(v)
Set bk1 = Workbooks.Open("C:\Service Recaps\" & v(i))
Set sh1 = bk1.Worksheets(sm)
If i = LBound(v) Then
Set rng1 = ws.Range(ws.Range("A7"), ws.Cells(Rows.Count,
1).End(xlUp))
rng1.EntireRow.Delete
Set rng = ws.Range("A7")
Else
Set rng = ws.Cells(Rows.Count, 1).End(xlUp)(2)
End If
Set rng2 = sh1.Range(sh1.Range("A9"), _
sh1.Cells(Rows.Count, 1).End(xlUp)).EntireRow
rng2.Copy Destination:=rng
bk1.Close SaveChanges:=False

Next 'should clarify next what?
End If
Next c


'LastRow = Range("A65536").End(xlUp).Row
Application.Run "SortReport"
Application.Run "Addtotals"

End Sub
'================================
i haven't tested this because i don't have your same set-up. so make
sure you save your workbook before you test this, because i'm not sure
if it will do what you want.
hope it helps.
(notice how the indents and spaces make each section easier to read.)
:)
susan




On Dec 5, 11:19*am, ParTeeGolfer
wrote:
Sorry about the code, it was copied and pasted the way I wrote itfrom my
workbook. The checkmark is in the format of a font as an "x"



"Susan" wrote:
ihopesomeonecanhelpyouandidon'tmeantobemeanbuttryi ngtoreadyourcodeisliketry*ingtoreadawholeparagraph withoutasinglespaceinbetweenthewords.

spaces and indents would be helpful.
:)
now, is the checkmark a checkbox from the control toolbox or forms
toolbar, or is it a font character?
susan

On Dec 5, 10:34 am, ParTeeGolfer
wrote:
I have this code that I want to modify to change instead of the "v= Array
(given names) I want to look for a check mark in column B of worksheet
"data". If there is a check mark then take the name from column A and goto
the portion of the code (For i = ) if not then next untill a blank cell is
reached columm A in worksheet "Data"

What I am trying to accomplish is to make this code more selective in the
names of the people I want to get data from. At this point the way the code
is now, I only have the option of getting the reports for the names listed in
the lines v=Array.

Here is the code I currently have and want to change this is in excel 2003:

Sub RecapReport()

Sheets("Recap Report").Select
Dim v As Variant, bk As Workbook, sh As Worksheet, ws As Worksheet
Dim bk1 As Workbook, sh1 As Worksheet
Dim sn As String, sm As String, sl As String, i As Long
Dim rng1 As Range, rng As Range
Dim rng2 As Range
Set bk = Workbooks("Recaps08.xls")
Set sh = bk.Worksheets("Data")
Set ws = bk.Worksheets("Recap Report")
sn = LCase(sh.Range("C3").Value)
sm = sh.Range("C4").Value
sl = sh.Range("C5").Value
If sn = "all" Then
v = Array("Tony Sarullo " & sl & ".xls", "John Mudaro " & sl & ".xls", "Ron
Ficarelli " & sl & ".xls")
Else
v = Array(sn & " " & sl)
End If
For i = LBound(v) To UBound(v)
Set bk1 = Workbooks.Open("C:\Service Recaps\" & v(i))
Set sh1 = bk1.Worksheets(sm)
If i = LBound(v) Then
Set rng1 = ws.Range(ws.Range("A7"), ws.Cells(Rows.Count, 1).End(xlUp))
rng1.EntireRow.Delete
Set rng = ws.Range("A7")
Else
Set rng = ws.Cells(Rows.Count, 1).End(xlUp)(2)
End If
Set rng2 = sh1.Range(sh1.Range("A9"), _
sh1.Cells(Rows.Count, 1).End(xlUp)).EntireRow
rng2.Copy Destination:=rng
bk1.Close SaveChanges:=False
Next
'LastRow = Range("A65536").End(xlUp).Row
Application.Run "SortReport"
Application.Run "Addtotals"
End Sub- Hide quoted text -

- Show quoted text -

Just the portion that builds the array:

Dim V as variant
Dim iRow as long
dim xCtr as long
dim HowMany As long
....

with sh 'bk.Worksheets("Data")

if howmany = 0 then
'no checkmarks, what should happen?
else
redim v(1 to howmany)
xctr = 0
for irow = 1 to .cells(.rows.count,"B").end(xlup).row
if lcase(.cells(irow,"B").value) = "x" then
xctr = xctr + 1
v(xctr) = .cells(irow,"A").value
end if
next irow
end if
end with

But I'm not sure what this means:
The checkmark is in the format of a font as an "x"

You may need these changes:
'to count the nonempty cells in column B
howmany = application.counta(.range("b:b"))

and
if .cells(irow,"B").value < "" then





ParTeeGolfer wrote:

Sorry about the code, it was copied and pasted the way I wrote itfrom my
workbook. The checkmark is in the format of a font as an "x"

"Susan" wrote:

ihopesomeonecanhelpyouandidon'tmeantobemeanbuttryi ngtoreadyourcodeisliketryingtoreadawholeparagraphw ithoutasinglespaceinbetweenthewords.

spaces and indents would be helpful.
:)
now, is the checkmark a checkbox from the control toolbox or forms
toolbar, or is it a font character?
susan


On Dec 5, 10:34 am, ParTeeGolfer
wrote:
I have this code that I want to modify to change instead of the "v= Array
(given names) I want to look for a check mark in column B of worksheet
"data". If there is a check mark then take the name from column A and goto
the portion of the code (For i = ) if not then next untill a blank cell is
reached columm A in worksheet "Data"

What I am trying to accomplish is to make this code more selective in the
names of the people I want to get data from. At this point the way the code
is now, I only have the option of getting the reports for the names listed in
the lines v=Array.

Here is the code I currently have and want to change this is in excel 2003:

Sub RecapReport()

Sheets("Recap Report").Select
Dim v As Variant, bk As Workbook, sh As Worksheet, ws As Worksheet
Dim bk1 As Workbook, sh1 As Worksheet
Dim sn As String, sm As String, sl As String, i As Long
Dim rng1 As Range, rng As Range
Dim rng2 As Range
Set bk = Workbooks("Recaps08.xls")
Set sh = bk.Worksheets("Data")
Set ws = bk.Worksheets("Recap Report")
sn = LCase(sh.Range("C3").Value)
sm = sh.Range("C4").Value
sl = sh.Range("C5").Value
If sn = "all" Then
v = Array("Tony Sarullo " & sl & ".xls", "John Mudaro " & sl & ".xls", "Ron
Ficarelli " & sl & ".xls")
Else
v = Array(sn & " " & sl)
End If
For i = LBound(v) To UBound(v)
Set bk1 = Workbooks.Open("C:\Service Recaps\" & v(i))
Set sh1 = bk1.Worksheets(sm)
If i = LBound(v) Then
Set rng1 = ws.Range(ws.Range("A7"), ws.Cells(Rows.Count, 1).End(xlUp))
rng1.EntireRow.Delete
Set rng = ws.Range("A7")
Else
Set rng = ws.Cells(Rows.Count, 1).End(xlUp)(2)
End If
Set rng2 = sh1.Range(sh1.Range("A9"), _
sh1.Cells(Rows.Count, 1).End(xlUp)).EntireRow
rng2.Copy Destination:=rng
bk1.Close SaveChanges:=False
Next
'LastRow = Range("A65536").End(xlUp).Row
Application.Run "SortReport"
Application.Run "Addtotals"
End Sub



--

Dave Peterson