bananatang
03-17-2010, 08:11 PM
Hi Guys,
i really could do with some help here. I have been banging my head for hours & hours trying to move forward to a workable solution.
My goal is to copy selected cell values (E5,E6,E7 & N6) from all attendance worksheets that contains a specific value in a nominated cell and paste to a worksheet. i.e if cell Z16 contains the numeric value 2, i want the macro to copy selected cells to another worksheet called "Weekly Attendance". If the cell contains any other value to ignore the worksheet.
In addition , within the workbook are other worksheets that are not related to attendance and should not be included in the macro.
To further complicate things some of the cell that i wish to be copied are fixed. i.e the cell location will not change. however i require to incorporate an input box in order for the user to choose which weeks data they wish to extract. The week No. are fixed within column B, range (B19:B72). Based on the location of the week no. the user has chosen. i want the macro to copy that cell value and the following 12 cells adjacent to the cell and post them in the "weekly attendance" worksheet, in addition to the fixed cells values.
I have included the code that i have been working on, however it does need correcting. it is probably not the most efficient way of doing this. I am open to alternative methods of acheiving my goals.
I have also included a copy of my workbook for easier understanding.
I would appreciate any help anyone can provide.
Thanks
BT
Sub zzz()
Application.ScreenUpdating = False
Wkly_Attendance.Visible = xlSheetVisible 'Show wkly attendance worksheet
Wkly_Attendance.Select
Dim wks As Worksheet
Dim aryVals(1 To 1, 1 To 4)
Dim lOpenRow As Long
With Wkly_Attendance
.Range(.Cells(3, 1), .Cells(Rows.Count, 17)).ClearContents
'// Start filling at row two, as we cleared any prior run//
lOpenRow = 3
For Each wks In ThisWorkbook.Worksheets
n'If Range("Z16").Value = "2" Then
'// Test to ensure we're not grabbing data from a sheet we don't //
'// want to. NOTE: We are using the codename of RawData, not the //
'// sheet (tab) name //
If Not wks Is Wkly_Attendance _
And Not wks.Name = "test" _
And Not wks.Name = "test1" _
And Not wks.Name = "test2" Then
'// Fill an array with the vals; I think this should be faster //
'// than copying individual cells. //
aryVals(1, 1) = wks.Range("E5")
aryVals(1, 2) = wks.Range("E6")
aryVals(1, 3) = wks.Range("E7")
aryVals(1, 4) = wks.Range("N6")
'// dump the array into the next available row //
.Range(.Cells(lOpenRow, 1), .Cells(lOpenRow, 4)).Value = aryVals
lOpenRow = lOpenRow + 1
End If
Next
End With
MsgBox "Upload Complete", vbInformation + vbokok, "Upload Attendance Data"
End Sub
Sub input_box2()
Dim wks As Worksheet
Dim aryVals(1 To 1, 1 To 4)
Dim lOpenRow As Long
With Wkly_Attendance
.Range(.Cells(3, 5), .Cells(Rows.Count, 17)).ClearContents
'// Start filling at row two, as we cleared any prior run//
lOpenRow = 3
For Each wks In ThisWorkbook.Worksheets
Dim MyInput
MyInput = InputBox("Enter Week No.")
Range("B19:B74").Select
Selection.Find(What:=MyInput, After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
ActiveCell.Offset(, 0).Resize(, 13).Copy
Sheets("Weekly Attendance").Select
Range("E3").End(xlUp).Select
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Next
End With
End Sub
i really could do with some help here. I have been banging my head for hours & hours trying to move forward to a workable solution.
My goal is to copy selected cell values (E5,E6,E7 & N6) from all attendance worksheets that contains a specific value in a nominated cell and paste to a worksheet. i.e if cell Z16 contains the numeric value 2, i want the macro to copy selected cells to another worksheet called "Weekly Attendance". If the cell contains any other value to ignore the worksheet.
In addition , within the workbook are other worksheets that are not related to attendance and should not be included in the macro.
To further complicate things some of the cell that i wish to be copied are fixed. i.e the cell location will not change. however i require to incorporate an input box in order for the user to choose which weeks data they wish to extract. The week No. are fixed within column B, range (B19:B72). Based on the location of the week no. the user has chosen. i want the macro to copy that cell value and the following 12 cells adjacent to the cell and post them in the "weekly attendance" worksheet, in addition to the fixed cells values.
I have included the code that i have been working on, however it does need correcting. it is probably not the most efficient way of doing this. I am open to alternative methods of acheiving my goals.
I have also included a copy of my workbook for easier understanding.
I would appreciate any help anyone can provide.
Thanks
BT
Sub zzz()
Application.ScreenUpdating = False
Wkly_Attendance.Visible = xlSheetVisible 'Show wkly attendance worksheet
Wkly_Attendance.Select
Dim wks As Worksheet
Dim aryVals(1 To 1, 1 To 4)
Dim lOpenRow As Long
With Wkly_Attendance
.Range(.Cells(3, 1), .Cells(Rows.Count, 17)).ClearContents
'// Start filling at row two, as we cleared any prior run//
lOpenRow = 3
For Each wks In ThisWorkbook.Worksheets
n'If Range("Z16").Value = "2" Then
'// Test to ensure we're not grabbing data from a sheet we don't //
'// want to. NOTE: We are using the codename of RawData, not the //
'// sheet (tab) name //
If Not wks Is Wkly_Attendance _
And Not wks.Name = "test" _
And Not wks.Name = "test1" _
And Not wks.Name = "test2" Then
'// Fill an array with the vals; I think this should be faster //
'// than copying individual cells. //
aryVals(1, 1) = wks.Range("E5")
aryVals(1, 2) = wks.Range("E6")
aryVals(1, 3) = wks.Range("E7")
aryVals(1, 4) = wks.Range("N6")
'// dump the array into the next available row //
.Range(.Cells(lOpenRow, 1), .Cells(lOpenRow, 4)).Value = aryVals
lOpenRow = lOpenRow + 1
End If
Next
End With
MsgBox "Upload Complete", vbInformation + vbokok, "Upload Attendance Data"
End Sub
Sub input_box2()
Dim wks As Worksheet
Dim aryVals(1 To 1, 1 To 4)
Dim lOpenRow As Long
With Wkly_Attendance
.Range(.Cells(3, 5), .Cells(Rows.Count, 17)).ClearContents
'// Start filling at row two, as we cleared any prior run//
lOpenRow = 3
For Each wks In ThisWorkbook.Worksheets
Dim MyInput
MyInput = InputBox("Enter Week No.")
Range("B19:B74").Select
Selection.Find(What:=MyInput, After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
ActiveCell.Offset(, 0).Resize(, 13).Copy
Sheets("Weekly Attendance").Select
Range("E3").End(xlUp).Select
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Next
End With
End Sub