K
Kstalker
I cannot get the code below to find the date values in the
'Rows("3:3").Select' it will not recognize them. When I hard key them
in, no problem but when it is an underlying formula, no good.
What have I done wrong???
Sub UpdateFrmLoad()
Dim Datelist(5) As String
With Update
..TxtDate = Format(DateAdd("d", -1, Date), "dd/mm/yy")
End With
Update.Show
End Sub
Sub UpdateFTEU(TxtDate As Date)
Dim Destination As String
Dim Source As String
Dim Refresh As String
Dim Refresh2 As String
startsheet = ActiveSheet.Name
Destination = "FTEU"
Source = "HeadcountData"
Refresh = "DataA"
Refresh2 = "DataS"
'On Error GoTo Somethingamiss
'get choosen dates column
Sheets(Destination).Activate
Rows("3:3").Select
Cells.Find(What:=TxtDate, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Cref = ActiveCell.Column
c1 = ColumnLetter(ActiveSheet.Columns(Cref))
'clear old contents Destinataion
Sheets(Destination).Select
Range(Cells(26, c1), Cells(83, c1)).Select
Selection.ClearContents
'Update query and refresh formulas Actuals equip page
Sheets(Source).Activate
Range("A2").Select
Selection.QueryTable.Refresh BackgroundQuery:=False
'input data
Sheets(Destination).Activate
Range(Cells(26, 6), Cells(83, 6)).Select
Selection.Copy
Cells(26, c1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
'Update query and refresh formulas Actuals equip page
'Sheets(Refresh).Activate
'Range("A2").Select
'Selection.QueryTable.Refresh BackgroundQuery:=False
'Update query and refresh formulas Actuals equip page
'Sheets(Refresh2).Activate
'Range("A2").Select
'Selection.QueryTable.Refresh BackgroundQuery:=False
'return to start sheet
Sheets(startsheet).Activate
'handle errors or success
GoTo Success
Somethingamiss:
MsgBox ("Error occured you better start checking stuff and generally
panic")
Success:
End Sub
Function ColumnLetter(rng As Range) As String
'Precondition:
'- range is a single cell, range or column
'- range is Row is not allowed (returns the rownumber)
'Testcases:
'Debug.Print ColumnLetter(ActiveSheet.Range("b1")) '>>B
'Debug.Print ColumnLetter(ActiveSheet.Range("bb1:bc1"))'>>BB
'Debug.Print ColumnLetter(ActiveSheet.Columns(2)) '>>B
'Debug.Print ColumnLetter(ActiveSheet.Columns(31)) '>>AE
'Debug.Print ColumnLetter(ActiveSheet.Columns(31)) '>>31
Dim strAddress As String
strAddress = rng.Address
' Because .Address is $$, drop the first
' character and the characters after the column letter(s).
ColumnLetter = Mid(strAddress, InStr(strAddress, "$") + 1, InStr(2,
strAddress, "$") - 2)
'remove : in case of input is column (address looks like $A:$A and
will return A
ColumnLetter = Replace(ColumnLetter, ":", "")
End Function
Thanks
Kristan
'Rows("3:3").Select' it will not recognize them. When I hard key them
in, no problem but when it is an underlying formula, no good.
What have I done wrong???
Sub UpdateFrmLoad()
Dim Datelist(5) As String
With Update
..TxtDate = Format(DateAdd("d", -1, Date), "dd/mm/yy")
End With
Update.Show
End Sub
Sub UpdateFTEU(TxtDate As Date)
Dim Destination As String
Dim Source As String
Dim Refresh As String
Dim Refresh2 As String
startsheet = ActiveSheet.Name
Destination = "FTEU"
Source = "HeadcountData"
Refresh = "DataA"
Refresh2 = "DataS"
'On Error GoTo Somethingamiss
'get choosen dates column
Sheets(Destination).Activate
Rows("3:3").Select
Cells.Find(What:=TxtDate, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Cref = ActiveCell.Column
c1 = ColumnLetter(ActiveSheet.Columns(Cref))
'clear old contents Destinataion
Sheets(Destination).Select
Range(Cells(26, c1), Cells(83, c1)).Select
Selection.ClearContents
'Update query and refresh formulas Actuals equip page
Sheets(Source).Activate
Range("A2").Select
Selection.QueryTable.Refresh BackgroundQuery:=False
'input data
Sheets(Destination).Activate
Range(Cells(26, 6), Cells(83, 6)).Select
Selection.Copy
Cells(26, c1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
'Update query and refresh formulas Actuals equip page
'Sheets(Refresh).Activate
'Range("A2").Select
'Selection.QueryTable.Refresh BackgroundQuery:=False
'Update query and refresh formulas Actuals equip page
'Sheets(Refresh2).Activate
'Range("A2").Select
'Selection.QueryTable.Refresh BackgroundQuery:=False
'return to start sheet
Sheets(startsheet).Activate
'handle errors or success
GoTo Success
Somethingamiss:
MsgBox ("Error occured you better start checking stuff and generally
panic")
Success:
End Sub
Function ColumnLetter(rng As Range) As String
'Precondition:
'- range is a single cell, range or column
'- range is Row is not allowed (returns the rownumber)
'Testcases:
'Debug.Print ColumnLetter(ActiveSheet.Range("b1")) '>>B
'Debug.Print ColumnLetter(ActiveSheet.Range("bb1:bc1"))'>>BB
'Debug.Print ColumnLetter(ActiveSheet.Columns(2)) '>>B
'Debug.Print ColumnLetter(ActiveSheet.Columns(31)) '>>AE
'Debug.Print ColumnLetter(ActiveSheet.Columns(31)) '>>31
Dim strAddress As String
strAddress = rng.Address
' Because .Address is $$, drop the first
' character and the characters after the column letter(s).
ColumnLetter = Mid(strAddress, InStr(strAddress, "$") + 1, InStr(2,
strAddress, "$") - 2)
'remove : in case of input is column (address looks like $A:$A and
will return A
ColumnLetter = Replace(ColumnLetter, ":", "")
End Function
Thanks
Kristan