J
Juan Correa
Hello,
I have a bit of code that formats the contents of a worksheet and creates
some columns with formulas.
Here is the code:
Public Function LastFriday(SomeDate As Date) As Date
Dim myDate As Date
myDate = DateSerial(Year(SomeDate), Month(SomeDate) + 1, 0)
While Weekday(myDate, vbSunday) <> 6
myDate = DateAdd("d", -1, myDate)
Wend
LastFriday = myDate
End Function
Public Function NextPeriod(InvDate As Date) As Date
NextPeriod = DateSerial(Year(InvDate), Month(InvDate) + 1, 1)
End Function
Public Function CurrentPeriod(IDate As Date) As Date
CurrentPeriod = DateSerial(Year(IDate), Month(IDate), 1)
End Function
Sub FormatData()
Application.ScreenUpdating = False
ActiveWindow.DisplayGridlines = False
' Declarations
Dim DataWks As Worksheet
Dim LastRow As Long
Dim LastCol As Long
Dim PTCache As PivotCache
' Set the DataWks variable
Set DataWks = Worksheets("Data")
With DataWks
LastRow = ActiveSheet.UsedRange.Rows.Count - 6
LastCol = Range("IV1").End(xlToLeft).Column
' Create the "Period" Column
.Cells(1, LastCol).Copy
.Cells(1, LastCol + 1).PasteSpecial Paste:=xlPasteFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Cells(1, LastCol + 1).WrapText = False
.Cells(1, LastCol + 1).Value = "Booked Month"
.Columns(LastCol + 1).AutoFit
' Populate the Month Column with new Monts
.Range(.Cells(2, LastCol + 1), Cells(LastRow, LastCol + 1)).Formula = _
"=IF(MONTH(I2)=12,CurrentPeriod(I2),IF(I2<=LastFriday(I2),CurrentPeriod(I2),NextPeriod(I2)))"
.Range(.Cells(2, LastCol + 1), Cells(LastRow, LastCol + 1)).NumberFormat
= "MM-YYYY"
' Create the "Country" Column
Columns("B:B").Select
Selection.Insert Shift:=xlToRight
Selection.NumberFormat = "General"
.Cells(1, 1).Copy
.Cells(1, 2).PasteSpecial Paste:=xlPasteFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Cells(1, 2).WrapText = False
.Cells(1, 2).Value = "Country"
' Populate the Country Column with new Countries
.Range(.Cells(2, 2), Cells(LastRow, 2)).Formula = _
"=VLOOKUP(A2,ctry_lookup,2,false)"
.Columns("B:B").AutoFit
End With
End Sub
The good part:
* If I run the code from my "Data" worksheet, it all works perfectly and my
data gets formatted and the new columns with my formulas get added.
The problem:
I added a second worksheet to the workbook and added a simple button (not
activeX control) that runs the Sub() when clicked.
* When I click the button to run the Sub() I get a Runtime 1004 error at
this line:
..Range(.Cells(2, LastCol + 1), Cells(LastRow, LastCol + 1)).Formula = _
"=IF(MONTH(I2)=12,CurrentPeriod(I2),IF(I2<=LastFriday(I2),CurrentPeriod(I2),NextPeriod(I2)))"
* If I simply run the Sub() from the Tools menu the error will show up if I
am on any worksheet other than the one containg the data to be formatted.
If anyone can point me in the right direction as to why this error is
happening, I'd greatly appreciate it.
thanks
Juan Correa
I have a bit of code that formats the contents of a worksheet and creates
some columns with formulas.
Here is the code:
Public Function LastFriday(SomeDate As Date) As Date
Dim myDate As Date
myDate = DateSerial(Year(SomeDate), Month(SomeDate) + 1, 0)
While Weekday(myDate, vbSunday) <> 6
myDate = DateAdd("d", -1, myDate)
Wend
LastFriday = myDate
End Function
Public Function NextPeriod(InvDate As Date) As Date
NextPeriod = DateSerial(Year(InvDate), Month(InvDate) + 1, 1)
End Function
Public Function CurrentPeriod(IDate As Date) As Date
CurrentPeriod = DateSerial(Year(IDate), Month(IDate), 1)
End Function
Sub FormatData()
Application.ScreenUpdating = False
ActiveWindow.DisplayGridlines = False
' Declarations
Dim DataWks As Worksheet
Dim LastRow As Long
Dim LastCol As Long
Dim PTCache As PivotCache
' Set the DataWks variable
Set DataWks = Worksheets("Data")
With DataWks
LastRow = ActiveSheet.UsedRange.Rows.Count - 6
LastCol = Range("IV1").End(xlToLeft).Column
' Create the "Period" Column
.Cells(1, LastCol).Copy
.Cells(1, LastCol + 1).PasteSpecial Paste:=xlPasteFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Cells(1, LastCol + 1).WrapText = False
.Cells(1, LastCol + 1).Value = "Booked Month"
.Columns(LastCol + 1).AutoFit
' Populate the Month Column with new Monts
.Range(.Cells(2, LastCol + 1), Cells(LastRow, LastCol + 1)).Formula = _
"=IF(MONTH(I2)=12,CurrentPeriod(I2),IF(I2<=LastFriday(I2),CurrentPeriod(I2),NextPeriod(I2)))"
.Range(.Cells(2, LastCol + 1), Cells(LastRow, LastCol + 1)).NumberFormat
= "MM-YYYY"
' Create the "Country" Column
Columns("B:B").Select
Selection.Insert Shift:=xlToRight
Selection.NumberFormat = "General"
.Cells(1, 1).Copy
.Cells(1, 2).PasteSpecial Paste:=xlPasteFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Cells(1, 2).WrapText = False
.Cells(1, 2).Value = "Country"
' Populate the Country Column with new Countries
.Range(.Cells(2, 2), Cells(LastRow, 2)).Formula = _
"=VLOOKUP(A2,ctry_lookup,2,false)"
.Columns("B:B").AutoFit
End With
End Sub
The good part:
* If I run the code from my "Data" worksheet, it all works perfectly and my
data gets formatted and the new columns with my formulas get added.
The problem:
I added a second worksheet to the workbook and added a simple button (not
activeX control) that runs the Sub() when clicked.
* When I click the button to run the Sub() I get a Runtime 1004 error at
this line:
..Range(.Cells(2, LastCol + 1), Cells(LastRow, LastCol + 1)).Formula = _
"=IF(MONTH(I2)=12,CurrentPeriod(I2),IF(I2<=LastFriday(I2),CurrentPeriod(I2),NextPeriod(I2)))"
* If I simply run the Sub() from the Tools menu the error will show up if I
am on any worksheet other than the one containg the data to be formatted.
If anyone can point me in the right direction as to why this error is
happening, I'd greatly appreciate it.
thanks
Juan Correa