P
ParTeeGolfer
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
(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