I am writing a macro in one of the excel files. I want to run that from another excel sheet.
My code:
Sub Full_Automation()
Dim All_Submitted_Dates As Variant
Dim All_WorkWeek As Variant
Dim dctUnique_WorkWeek As Dictionary
Dim DateCounter As Long
Dim WorkWeekCounter As Long
Sheet1.Activate
Set dctUnique_WorkWeek = New Dictionary
With Sheet1
All_Submitted_Dates = Application.Transpose(.Range(.Range("K2"), .Cells(.Rows.Count, "K").End(xlUp)))
End With
WorkWeekCounter = 1
For DateCounter = 1 To UBound(All_Submitted_Dates)
If Not dctUnique_WorkWeek.Exists("WW" & WorksheetFunction.WeekNum(All_Submitted_Dates(DateCounter))) Then
dctUnique_WorkWeek.Add Key:="WW" & WorksheetFunction.WeekNum(All_Submitted_Dates(DateCounter)), Item:=1
Else
dctUnique_WorkWeek("WW" & WorksheetFunction.WeekNum(All_Submitted_Dates(DateCounter))) = dctUnique_WorkWeek("WW" & WorksheetFunction.WeekNum(All_Submitted_Dates(DateCounter))) + 1
End If
Next DateCounter
Worksheets.Add after:=Sheets(Sheets.Count)
Worksheets(3).Activate
Dim rowCounter As Long
Dim varKey As Variant
rowCounter = 2
For Each varKey In dctUnique_WorkWeek.Keys()
Range("A" & rowCounter).Value = varKey
Range("D" & rowCounter).Value = dctUnique_WorkWeek(varKey)
If rowCounter = 2 Then
Range("C" & rowCounter).Formula = "=B" & rowCounter
Range("E" & rowCounter).Formula = "=D" & rowCounter
Else
Range("C" & rowCounter).Formula = "=C" & (rowCounter - 1) & "+B" & rowCounter
Range("E" & rowCounter).Formula = "=E" & (rowCounter - 1) & "+D" & rowCounter
End If
rowCounter = rowCounter + 1
Next
End Sub
When I tried to debug the code line by line, I got to know that whenever I execute the line Sheet1.Activate
it going to the original excel file where my macro is present. How will I refer to the first worksheet of another workbook?
The Sheets
collection is a property of the Workbook
object (observe that the Sheets
collection is more inclusive than the worksheets
collection because not all Sheets
are Worksheets
). The default workbook is the ActiveWorkbook
and this will be addressed if you don't specify anything else.
You can assign a workbook to a variable declared as Workbook
.
Dim Wb As Workbook
Set Wb = ThisWorkbook
or
Set Wb = ActiveWorkbook
or
Set Wb = Workbooks.Open ([File name])
or
Set Wb = Workbooks.Add ([Template])
You can then address any sheet in the designated workbook.
Debug.Print Wb.Worksheets("Sheet1").Cells(1, 1).Value
Early binding can load the dictionary object within the initial declaration.
Set dctUnique_WorkWeek = New Dictionary
This creates a 1-D array but you start the increment in the For ... Next at 1, not zero. Probably better to simply use a 2-D array. In fact, I've it expedient to always use LBound to UBound for a For ... Next involving an array.
With Sheet1
All_Submitted_Dates = Application.Transpose(.Range(.Range("K2"), .Cells(.Rows.Count, "K").End(xlUp)))
End With
The codename Sheet1 is going to refer to the Sheet1 within the workbook containing the VBA project. Use the worksheet's name and provide an explicit parent workbook if external.
Sheet1.Activate
In fact, there is no need to .Activate a worksheet to reference it as long as an explicitly referenced parent workbook is provided.
dctUnique_WorkWeek("WW" & WorksheetFunction.WeekNum(All_Submitted_Dates(DateCounter))) = dctUnique_WorkWeek("WW" & WorksheetFunction.WeekNum(All_Submitted_Dates(DateCounter))) + 1
a) VBA's Format uses the ww format mask to retrieve the same number as WorksheetFunction.WeekNum. b) There is a shorthand 'countif in a dictionary' that bypasses the dictionary's Exists method.
WorkWeekCounter doesn't appear to be used beyond being declared and assigned a value of 1.
WorkWeekCounter = 1
You can write all of the keys and items at once. The formulas will require 2 steps due to the different formulas.
For Each varKey In dctUnique_WorkWeek.Keys()
Your formulas seem to reference column B yet no values are put into column B on the new worksheet.
Option Explicit
Sub Full_Automation()
Dim All_Submitted_Dates As Variant, dctUnique_WorkWeek As New Dictionary
Dim dc As Long
With ActiveWorkbook 'better as With Workbooks("Book1.xlsx")
With .Worksheets("Sheet1")
All_Submitted_Dates = .Range(.Cells(2, "K"), .Cells(.Rows.Count, "K").End(xlUp)).Value2
End With
For dc = LBound(All_Submitted_Dates, 1) To UBound(All_Submitted_Dates, 1)
dctUnique_WorkWeek.Item("WW" & Right(Format(All_Submitted_Dates(dc, 1), "\0ww"), 2)) = _
dctUnique_WorkWeek.Item("WW" & Right(Format(All_Submitted_Dates(dc, 1), "\0ww"), 2)) + 1
Next dc
Worksheets.Add After:=.Sheets(.Sheets.Count)
With .Sheets(.Sheets.Count)
'name = "give the new worksheet a name"
.Cells(2, "A").Resize(dctUnique_WorkWeek.Count, 1) = Application.Transpose(dctUnique_WorkWeek.keys)
.Cells(2, "D").Resize(dctUnique_WorkWeek.Count, 1) = Application.Transpose(dctUnique_WorkWeek.items)
'optionally sort the weeks
With .Cells(2, "A").Resize(dctUnique_WorkWeek.Count, 4)
.Sort key1:=.Cells(1), order1:=xlAscending, Header:=xlNo
End With
.Cells(2, "C").Formula = "=B2"
.Cells(2, "E").Formula = "=D2"
.Range(.Cells(3, "C"), .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 2)).Formula = "=C2+B3"
.Range(.Cells(3, "E"), .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 4)).Formula = "=E2+D3"
End With
End With
End Sub
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.