need macro for auto year workbook with auto months and dates

**thickwall** · 09-07-2019, 12:23 PM

I need help in Macro for date and time in rows of workbook

Workbook contain 12 sheets Having Names Of Months
like Sheet 1 = January
Sheet 2 = February
Sheet 12 = December

every sheet contains its date like January have 31 days that means Row will be 31 and so on

Auto Generation of Workbook of relative Year like 2019 is the workbook then auto generation of months in the work book sheet and auto generation of Days in relative month sheets
after this when i fetch the data thru vba it should validate the system date and time and nd copy the data according to the system date and time the data will be fetch and placed in its position like if i have schedule task to fetch a data everyday at 7 am then rows of sheet containing date must concatenate with running time schedule task

example if data called on 1st september 2019 then work book of name with 2019 will open and then sheet with name of Sept should open and then in row with date 1 where data will be placed and having date 1 in cell the time will concatenate with 1 showing calling date and time

Faconclientssp3 macro is as follows

Dim server As Object

'Sub Button1_Click()
Private Sub Workbook_Open()
'Application.Wait Now() + TimeValue("00:00:10")
'For a = 1 To 10
'MsgBox (a)
'Next
'Sub Button1_Click()
Set server = CreateObject("faconsvr.faconserver")
server.openproject ("C:\Documents and Settings\LMS\My Documents\SSP3\FaconClientSSP3.fcs")
server.Connect
Application.Wait Now() + TimeValue("00:00:03")
'timer1.enable = True
Worksheets("Sheet1").Range("g16") = server.getitem("channel0.station0.group_kw", "DR1100")
Worksheets("Sheet1").Range("g17") = server.getitem("channel0.station0.group_kw", "DR1102")
Worksheets("Sheet1").Range("g18") = server.getitem("channel0.station0.group_kw", "DR1104")
Worksheets("Sheet1").Range("g19") = server.getitem("channel0.station0.group_kw", "DR1106")
Worksheets("Sheet1").Range("g20") = server.getitem("channel0.station0.group_kw", "DR1108")
Worksheets("Sheet1").Range("g21") = server.getitem("channel0.station0.group_kw", "DR1110")
Worksheets("Sheet1").Range("g22") = server.getitem("channel0.station0.group_kw", "DR1112")
Worksheets("Sheet1").Range("g23") = server.getitem("channel0.station0.group_kw", "DR1114")
Worksheets("Sheet1").Range("g24") = server.getitem("channel0.station0.group_kw", "DR1116")
Worksheets("Sheet1").Range("g25") = server.getitem("channel0.station0.group_kw", "DR1118")
Worksheets("Sheet1").Range("g26") = server.getitem("channel0.station0.group_kw", "DR1120")
Worksheets("Sheet1").Range("g27") = server.getitem("channel0.station0.group_kw", "DR1122")
Worksheets("Sheet1").Range("g28") = server.getitem("channel0.station0.group_kw", "DR1124")
Worksheets("Sheet1").Range("g29") = server.getitem("channel0.station0.group_kw", "DR1126")
Worksheets("Sheet1").Range("g30") = server.getitem("channel0.station0.group_kw", "DR1128")
Worksheets("Sheet1").Range("g31") = server.getitem("channel0.station0.group_kw", "DR1130")
Worksheets("Sheet1").Range("g32") = server.getitem("channel0.station0.group_kw", "DR1132")
Worksheets("Sheet1").Range("g33") = server.getitem("channel0.station0.group_kw", "DR1134")
Worksheets("Sheet1").Range("g34") = server.getitem("channel0.station0.group_kw", "DR1136")
Worksheets("Sheet1").Range("g35") = server.getitem("channel0.station0.group_kw", "DR1138")
Worksheets("Sheet1").Range("g36") = server.getitem("channel0.station0.group_kw", "DR1140")
Worksheets("Sheet1").Range("g37") = server.getitem("channel0.station0.group_kw", "DR1142")
Worksheets("Sheet1").Range("g38") = server.getitem("channel0.station0.group_kw", "DR1144")
Worksheets("Sheet1").Range("g39") = server.getitem("channel0.station0.group_kw", "DR1146")
Worksheets("Sheet1").Range("g40") = server.getitem("channel0.station0.group_kwh", "DR2200")
Worksheets("Sheet1").Range("g41") = server.getitem("channel0.station0.group_kwh", "DR2202")
Worksheets("Sheet1").Range("g42") = server.getitem("channel0.station0.group_kwh", "DR2204")
Worksheets("Sheet1").Range("g43") = server.getitem("channel0.station0.group_kwh", "DR2206")
Worksheets("Sheet1").Range("g44") = server.getitem("channel0.station0.group_kwh", "DR2208")
Worksheets("Sheet1").Range("g45") = server.getitem("channel0.station0.group_kwh", "DR2210")
Worksheets("Sheet1").Range("g46") = server.getitem("channel0.station0.group_kwh", "DR2212")
Worksheets("Sheet1").Range("g47") = server.getitem("channel0.station0.group_kwh", "DR2214")
Worksheets("Sheet1").Range("g48") = server.getitem("channel0.station0.group_kwh", "DR2216")
Worksheets("Sheet1").Range("g49") = server.getitem("channel0.station0.group_kwh", "DR2218")
Worksheets("Sheet1").Range("g50") = server.getitem("channel0.station0.group_kwh", "DR2220")
Worksheets("Sheet1").Range("g51") = server.getitem("channel0.station0.group_kwh", "DR2222")
Worksheets("Sheet1").Range("g52") = server.getitem("channel0.station0.group_kwh", "DR2224")
Worksheets("Sheet1").Range("g53") = server.getitem("channel0.station0.group_kwh", "DR2226")
Worksheets("Sheet1").Range("g54") = server.getitem("channel0.station0.group_kwh", "DR2228")
Worksheets("Sheet1").Range("g55") = server.getitem("channel0.station0.group_kwh", "DR2230")
Worksheets("Sheet1").Range("g56") = server.getitem("channel0.station0.group_kwh", "DR2232")
Worksheets("Sheet1").Range("g57") = server.getitem("channel0.station0.group_kwh", "DR2234")
Worksheets("Sheet1").Range("g58") = server.getitem("channel0.station0.group_kwh", "DR2236")
Worksheets("Sheet1").Range("g59") = server.getitem("channel0.station0.group_kwh", "DR2238")
Worksheets("Sheet1").Range("g60") = server.getitem("channel0.station0.group_kwh", "DR2240")
Worksheets("Sheet1").Range("g61") = server.getitem("channel0.station0.group_kwh", "DR2242")
Worksheets("Sheet1").Range("g62") = server.getitem("channel0.station0.group_kwh", "DR2244")
Worksheets("Sheet1").Range("g63") = server.getitem("channel0.station0.group_kwh", "DR2246")
'close filename "C:\Documents and Settings\LMS\My Documents\My Music\closefacon.bat"
'Application.Quit ("C:\Documents and Settings\LMS\My Documents\My Music\facon clients.fcs")
'server.Application.Quit ("C:\Documents and Settings\LMS\My Documents\My Music\facon clients.fcs")
With Workbooks("FaconClientSSP3.xls").Worksheets("Sheet1").Range("G16:G63").Copy
'Range("G25").Select
'Selection.Copy
'Range("H25").Select
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
':=False, Transpose:=False
Workbooks.Open filename:= _
"C:\Documents and Settings\LMS\My Documents\SSP3\SSP3FDRDATA2016.xls"
Select Case Month(Now())
Case 1
s = "JANUARY"
Case 2
s = "FABUARY"
Case 3
s = "MARCH"
Case 4
s = "APRIL"
Case 5
s = "MAY"
Case 6
s = "JUNE"
Case 7
s = "JULY"
Case 8
s = "AUGUST"
Case 9
s = "SEPTEMBER"
Case 10
s = "OCTOBER"
Case 11
s = "NOVEMBER"
Case 12
s = "DECEMBER"
End Select
'Range("H25").Select
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
':=False, Transpose:=False
Select Case Day(Now())
Case 1
Excel.Sheets(s).Select
Range("G16:G63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("G14") = Time()
Case 2
Excel.Sheets(s).Select
Range("H16:H63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("H14") = Time()
Case 3
Excel.Sheets(s).Select
Range("I16:I63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("I14") = Time()
Case 4
Excel.Sheets(s).Select
Range("J16:J63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("J14") = Time()
Case 5
Excel.Sheets(s).Select
Range("K16:K63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("K14") = Time()
Case 6
Excel.Sheets(s).Select
Range("L16:L63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("L14") = Time()
Case 7
Excel.Sheets(s).Select
Range("M16:M63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("M14") = Time()
Case 8
Excel.Sheets(s).Select
Range("N16:N63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("N14") = Time()
Case 9
Excel.Sheets(s).Select
Range("O16:O63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("O14") = Time()
Case 10
Excel.Sheets(s).Select
Range("P16:P63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("P14") = Time()
Case 11
Excel.Sheets(s).Select
Range("Q16:Q63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("Q14") = Time()
Case 12
Excel.Sheets(s).Select
Range("R16:R63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("R14") = Time()
Case 13
Excel.Sheets(s).Select
Range("S16:S29").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("S14") = Time()
Case 14
Excel.Sheets(s).Select
Range("T16:T63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("T14") = Time()
Case 15
Excel.Sheets(s).Select
Range("U16:U63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("U14") = Time()
Case 16
Excel.Sheets(s).Select
Range("V16:V63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("V14") = Time()
Case 17
Excel.Sheets(s).Select
Range("W16:W63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("W14") = Time()
Case 18
Excel.Sheets(s).Select
Range("X16:X63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("X14") = Time()
Case 19
Excel.Sheets(s).Select
Range("Y16:Y63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("Y14") = Time()
Case 20
Excel.Sheets(s).Select
Range("Z16:Z63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("Z14") = Time()
Case 21
Excel.Sheets(s).Select
Range("AA16:AA63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AA14") = Time()
Case 22
Excel.Sheets(s).Select
Range("AB16:AB63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AB14") = Time()
Case 23
Excel.Sheets(s).Select
Range("AC16:AC63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AC14") = Time()
Case 24
Excel.Sheets(s).Select
Range("AD16:AD63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AD14") = Time()
Case 25
Excel.Sheets(s).Select
Range("AE16:AE63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AE14") = Time()
Case 26
Excel.Sheets(s).Select
Range("AF16:AF63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AF14") = Time()
Case 27
Excel.Sheets(s).Select
Range("AG16:AG63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AG14") = Time()
Case 28
Excel.Sheets(s).Select
Range("AH16:AH63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AH14") = Time()
Case 29
Excel.Sheets(s).Select
Range("AI16:AI63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AI14") = Time()
Case 30
Excel.Sheets(s).Select
Range("AJ16:AJ63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AJ14") = Time()
Case 31
Excel.Sheets(s).Select
Range("AK16:AK63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AK14") = Time()
End Select
'''''''''''''''''''''''''''MOLDING LMS TEXT FILE CREATION''''''''''''''''''''
Dim sName As String
Dim rng_1 As Range, cell_1 As Range
Dim rng_2 As Range, cell_2 As Range
'sName = ActiveSheet.Name
'sName = Application.GetSaveFilename( _
InitialFileName:=sName & ".txt", _
FileFilter:="Text Files (*.txt),*.txt")
'If sName = "" Then Exit Sub
Open "C:\Documents and Settings\LMS\My Documents\NA_Folder\MOLDLmsText.txt" For Output As #1
Set rng_1 = Range(Range("C55"), _
Cells(Rows.Count, 3).End(xlUp))
For Each cell_1 In rng_1
Print #1, cell_1.Offset(0, 0).Text
Print #1, cell_1.Offset(0, 4).Text
Print #1,
Next
End With
ActiveWorkbook.Save
ActiveWorkbook.Close
'Call MyOPCServer.Disconnect
'Set MyOPCServer = Nothing
ActiveWorkbook.Save
'ActiveWorkbook.Closed SaveChanges = 1
Application.Quit
End Sub

Private Sub closeprogram()
myAppid = Shell("C:\Program Files\Fatek\FaconSvr\FaconSvr.exe", 1)
SendKeys "%{F4}", True
End Sub

it runs in schedule task where data is transfered in a file (image is attached) ...ssp3 decr run when image file have data to transfer from this file into another daily energy consumption sheet...i want it in one go which ...file is of 2007 but ill use 2016 excel kindly help

**Leith Ross** · 09-07-2019, 05:16 PM

Hello thickwall,

Welcome to the forum!

Your VBA Project in the workbook "FaconClientSSP3.xls" is password protected. Please post the password or another copy of the workbook with the VBA Project unlocked.

**Leith Ross** · 09-07-2019, 06:10 PM

Hello thickwall,

The code you posted for Button1 can be replaced with this code...

Sub Private Workbook_Open()
    Dim Col     As Long
    Dim Data    As Variant
    Dim Row     As Long
    Dim Text    As String
    Dim Item    As Variant
    Dim Wks     As Worksheet
    Dim Wkb1    As Workbook
    Dim Wkb2    As Workbook
    
        Set server = CreateObject("faconsvr.faconserver")
            server.openproject ("C:\Documents and Settings\LMS\My Documents\SSP3\FaconClientSSP3.fcs")
            server.Connect
            
        Application.Wait Now() + TimeValue("00:00:03")
        
        For Row = 16 To 63
            If Row < 40 Then
                Item = "DR11" & Format(((Row - 16) * 2), "00")
            Else
                Item = "DR22" & Format(((Row - 16) * 2), "00")
            End If
            
            Worksheets("Sheet1").Cells(Row, "G") = server.getitem("channel0.station0.group_kw", Item)
        Next Row
                
        Set Wkb1 = Workbooks("FaconClientSSP3.xls")
        Set Wks = Wkb1.Worksheets("sheet1")
        
        Data = Wks.Range("G16:G63").Value
        
        Wks.Range("H25").Resize(UBound(Data), 1).Value = Data


        Set Wkb2 = Workbooks.Open(Filename:="C:\Documents and Settings\LMS\My Documents\SSP3\SSP3FDRDATA2016.xls")
        Set Wks = Wkb2.Worksheets(UCase(Format(Now(), "mmmm")))
        
        Col = Day(Now()) + 6
        
        Wks.Range(Wks.Cells(16, Col), Wks.Cells(63, Col)).Value = Data
        Wks.Cells(14, Col) = Time()


        Open "C:\Documents and Settings\LMS\My Documents\NA_Folder\MOLDLmsText.txt" For Output As #1
            For Each cell In Wks.Range(Wks.Cells(55, "C"), Wks.Cells(Rows.Count, "C").End(xlUp))
                Text = cell.Text & vbCrLf & cell.Offset(0, 4).Text & vbCrLf & vbCrLf
                Print #1, Text
            Next cell
        Close #1


        Wkb2.Close SaveChanges:=True
        Wkb1.Close SaveChanges:=True
        
        Application.Quit


End Sub

**Leith Ross** · 09-07-2019, 10:56 PM

Duplicate Post

Thread: need macro for auto year workbook with auto months and dates

Thread Tools

Display

need macro for auto year workbook with auto months and dates

Posting Permissions