Ann_BBO
07-23-2007, 01:46 AM
I want to adjust the range row index in this sequence.
(1) (2) (3) (4)......
A8 ->A18 ->A28 ->A38...
Start from 8 , then add 10 after in each time. Therefore, I set y as integer. Then, i try to modify and the modified vba as show below:
Private Sub cmdResult_Click()
Dim Tgt As Worksheet
Dim Source As Range
Dim wbSource As Workbook
Dim cel As Range
Dim Rng As Range
Dim c As Range
Dim y As Integer
For x = 0 To ListBox1.ListCount - 1
Application.ScreenUpdating = False
Set Tgt = ActiveSheet
Set wbSource = Workbooks.Open(Filename:=ListBox1.List(x))
Set Source = wbSource.Sheets(1).Columns(1)
With Tgt
.Activate
'clear old data
Range(.Cells((8 + y), 2), .Cells((12 + y), 5)).ClearContents
' Change the name to obey the data structure
If Range("a8+y").Value = "001" Then
Range("a8+y").Value = "Staff 001"
End If
If Range("a9+y").Value = "002" Then
Range("a9+y").Value = "Staff 002"
End If
If Range("a10+y").Value = "003" Then
Range("a10+y").Value = "Staff 003"
End If
If Range("a11+y").Value = "004" Then
Range("a11+y").Value = "Staff 004"
End If
If Range("a12+y").Value = "005" Then
Range("a12+y").Value = "Staff 005"
End If
'Loop through names in column A
For Each cel In Range("A8+y:A12+y")
If Not cel = "" Then
Set c = Source.Range("A3")
Set Rng = Nothing
Do While c.Row < Source.Range("A" & Source.Rows.Count).End(xlUp).Row
If c = cel Then
If Rng Is Nothing Then Set Rng = c.Offset(1)
Set Rng = Union(Rng, Range(c.Offset(1), c.Offset(1).End(xlDown)))
Set c = c.Offset(1).End(xlDown).Offset(1)
Else
Set c = c.Offset(1)
End If
Loop
cel.Offset(, 1) = Application.Average(Rng.Offset(, 1))
cel.Offset(, 2) = Application.Average(Rng.Offset(, 2))
cel.Offset(, 3) = Application.Average(Rng.Offset(, 3))
cel.Offset(, 4) = Application.Average(Rng.Offset(, 4))
End If
Next
End With
' Refill the original name into range
Range("a8+y").Value = "001"
Range("a9+y").Value = "002"
Range("a10+y").Value = "003"
Range("a11+y").Value = "004"
Range("a12+y").Value = "005"
wbSource.Close False
Application.ScreenUpdating = True
Next
End Sub
How to modify the above vba which can A8 at first time, then A18,A28.... Until the ListBox1.ListCount - 1
Thank you
(1) (2) (3) (4)......
A8 ->A18 ->A28 ->A38...
Start from 8 , then add 10 after in each time. Therefore, I set y as integer. Then, i try to modify and the modified vba as show below:
Private Sub cmdResult_Click()
Dim Tgt As Worksheet
Dim Source As Range
Dim wbSource As Workbook
Dim cel As Range
Dim Rng As Range
Dim c As Range
Dim y As Integer
For x = 0 To ListBox1.ListCount - 1
Application.ScreenUpdating = False
Set Tgt = ActiveSheet
Set wbSource = Workbooks.Open(Filename:=ListBox1.List(x))
Set Source = wbSource.Sheets(1).Columns(1)
With Tgt
.Activate
'clear old data
Range(.Cells((8 + y), 2), .Cells((12 + y), 5)).ClearContents
' Change the name to obey the data structure
If Range("a8+y").Value = "001" Then
Range("a8+y").Value = "Staff 001"
End If
If Range("a9+y").Value = "002" Then
Range("a9+y").Value = "Staff 002"
End If
If Range("a10+y").Value = "003" Then
Range("a10+y").Value = "Staff 003"
End If
If Range("a11+y").Value = "004" Then
Range("a11+y").Value = "Staff 004"
End If
If Range("a12+y").Value = "005" Then
Range("a12+y").Value = "Staff 005"
End If
'Loop through names in column A
For Each cel In Range("A8+y:A12+y")
If Not cel = "" Then
Set c = Source.Range("A3")
Set Rng = Nothing
Do While c.Row < Source.Range("A" & Source.Rows.Count).End(xlUp).Row
If c = cel Then
If Rng Is Nothing Then Set Rng = c.Offset(1)
Set Rng = Union(Rng, Range(c.Offset(1), c.Offset(1).End(xlDown)))
Set c = c.Offset(1).End(xlDown).Offset(1)
Else
Set c = c.Offset(1)
End If
Loop
cel.Offset(, 1) = Application.Average(Rng.Offset(, 1))
cel.Offset(, 2) = Application.Average(Rng.Offset(, 2))
cel.Offset(, 3) = Application.Average(Rng.Offset(, 3))
cel.Offset(, 4) = Application.Average(Rng.Offset(, 4))
End If
Next
End With
' Refill the original name into range
Range("a8+y").Value = "001"
Range("a9+y").Value = "002"
Range("a10+y").Value = "003"
Range("a11+y").Value = "004"
Range("a12+y").Value = "005"
wbSource.Close False
Application.ScreenUpdating = True
Next
End Sub
How to modify the above vba which can A8 at first time, then A18,A28.... Until the ListBox1.ListCount - 1
Thank you