Thanks Per, This worked out great.............. Thanks for your help

"Per Jessen" wrote:

Hi

My fault :-(, forgot that Dim V as Variant shoud be changed to:

Dim V() as Variant 'Indicating that V is an array

Regards,
Per

On 12 Dec., 20:11, ParTeeGolfer
wrote:
I tried the code as you suggested however I get a Runtime error 13 Type
mismatch in the line with: For i = LBound(v) To UBound(v)



"Per Jessen" wrote:
Hi

I think this should do it:

Dim FirstCell As Range
Dim LastCell As Range
Dim xCount As Long

If sn = "all" Then
Set FirstCell = sh.Range("B2")
Set LastCell = sh.Range("B" & Rows.Count).End(xlUp)
For Each cell In Range(FirstCell, LastCell)
If cell.Value = "X" Then
ReDim Preserve v(xCount)
v(xCount) = cell.Offset(0, -1).Value & sl & "..xls"
xCount = xCount + 1
End If
Next

Regards,
Per

On 12 Dec., 18:26, ParTeeGolfer
wrote:
I need help with a vaiable issue.........See below in caps for issue. Thanks
for any help, I am getting a headach tring to figuire this one out!

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("D3").Value)
sm = sh.Range("D4").Value
sl = sh.Range("D5").Value
If sn = "all" Then

THIS IS THE LINE I NEED TO CHANGE TO A VAIABLE PENDING EACH CELL IN COLUMN B
FROM WORKSHEET "Data" THAT HAS AN "X" IN IT, WILL THEN GET THE NAME FROM
COLUMN A. IF A CELL IN COLUMN B DOES NOT HAVE AN "X" THEN NEXT UNTILL 5
CELLS IN A ROW IN COLUMN B = "".

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- Skjul tekst i anførselstegn -

- Vis tekst i anførselstegn -