VBA Read dates

Andyb2

New Member
Joined
Jan 24, 2021
Messages
15
Office Version
  1. 365
Platform
  1. Windows
Hi all,

I have created a macro below using the recording function.

A) My macro code is quite long and I wanted to shorten it if possible, the main thing is when I highlight all the column to then make the table takes up lots of space?
B) I would like to convert the financial year dates as listed below to ordinary year dates. For example, in column AM I would like it to display (2018 04 as December 2018) and (2019 03 as 2019). The year and period are listed in column Q and R. However, i'm not sure the code to add, please can you help.

  • 2018 04 – December 2018
  • 2018 05 – January 2019
  • 2018 06 – February 2019
  • 2018 07 – March 2019
  • 2018 08 – April 2019
  • 2018 10 – May 2019
  • 2018 11- June 2019
  • 2018 12- July 2019
  • 2019 01 – August 2019
  • 2019 02 – September 2019
  • 2019 03 – October 2019
  • 2019 04 – November 2019
  • 2019 05 – December 2019
  • 2019 06 – January 2020

VBA Code:
Sub Andy_New_Macro_2()

'

' Andy_New_Macro_2 Macro

'



'

Sheets("_Keywords").Select

ActiveWindow.SelectedSheets.Visible = False

Sheets("Customer Funder Account Mapping").Select

ActiveWindow.SelectedSheets.Visible = False

Sheets("Exchange Rate Query RMID - King").Select

ActiveWindow.SelectedSheets.Visible = False

Sheets("RESPROJ Budget Load Summary").Select

ActiveWindow.SelectedSheets.Visible = False

ActiveWindow.ScrollWorkbookTabs Sheets:=-1

ActiveWindow.ScrollWorkbookTabs Sheets:=-1

Sheets("RESPROJ Budget Load Check").Select

ActiveWindow.SelectedSheets.Visible = False

Sheets("Standard Browser Enquiry POST A").Select

Columns("A:A").Select

Selection.Delete Shift:=xlToLeft

Rows("1:1").Select

Selection.Delete Shift:=xlUp

Range("B8").Select

Application.CutCopyMode = False

ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A:$AL"), , xlYes).Name = _

"Table1"

Columns("A:AL").Select

ActiveSheet.ListObjects("Table1").TableStyle = "TableStyleLight1"

ActiveWindow.ScrollColumn = 28

ActiveWindow.ScrollColumn = 27

ActiveWindow.ScrollColumn = 26

ActiveWindow.ScrollColumn = 25

ActiveWindow.ScrollColumn = 24

ActiveWindow.ScrollColumn = 23

ActiveWindow.ScrollColumn = 22

ActiveWindow.ScrollColumn = 21

ActiveWindow.ScrollColumn = 20

ActiveWindow.ScrollColumn = 19

ActiveWindow.ScrollColumn = 18

ActiveWindow.ScrollColumn = 17

ActiveWindow.ScrollColumn = 16

ActiveWindow.ScrollColumn = 15

ActiveWindow.ScrollColumn = 14

ActiveWindow.ScrollColumn = 13

ActiveWindow.ScrollColumn = 12

ActiveWindow.ScrollColumn = 11

ActiveWindow.ScrollColumn = 10

ActiveWindow.ScrollColumn = 11

ActiveWindow.ScrollColumn = 12

ActiveWindow.ScrollColumn = 13

ActiveWindow.ScrollColumn = 14

ActiveWindow.ScrollColumn = 15

ActiveWindow.ScrollColumn = 16

ActiveWindow.ScrollColumn = 17

ActiveWindow.ScrollColumn = 18

ActiveWindow.ScrollColumn = 19

ActiveWindow.ScrollColumn = 20

ActiveWindow.ScrollColumn = 21

ActiveWindow.ScrollColumn = 22

ActiveWindow.ScrollColumn = 21

ActiveWindow.ScrollColumn = 20

ActiveWindow.ScrollColumn = 19

ActiveWindow.ScrollColumn = 18

ActiveWindow.ScrollColumn = 17

ActiveWindow.ScrollColumn = 16

ActiveWindow.ScrollColumn = 15

Range("R4").Select

ActiveWorkbook.Worksheets("Standard Browser Enquiry POST A").ListObjects( _

"Table1").Sort.SortFields.Clear

ActiveWorkbook.Worksheets("Standard Browser Enquiry POST A").ListObjects( _

"Table1").Sort.SortFields.Add2 Key:=Columns("R:R"), SortOn:=xlSortOnValues _

, Order:=xlAscending, DataOption:=xlSortNormal

With ActiveWorkbook.Worksheets("Standard Browser Enquiry POST A").ListObjects( _

"Table1").Sort

.Header = xlYes

.MatchCase = False

.Orientation = xlTopToBottom

.SortMethod = xlPinYin

.Apply

End With

Sheets("Standard Browser Enquiry POST A").Select

Sheets("Standard Browser Enquiry POST A").Name = "R03 Transactions"

Sheets("Summary").Select

Sheets("Summary").Name = "R05 Summary"

Range("D12").Select

Sheets("R03 Transactions").Select

Columns("O:O").ColumnWidth = 19.47

Columns("O:O").ColumnWidth = 29.07

Columns("O:O").ColumnWidth = 36.4
 

Attachments

  • Picture2.jpg
    Picture2.jpg
    74.9 KB · Views: 14

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".
Welcome to MrExcel Message Board.
Please upload your example file & Desired Results with XL2BB ADDIN at above of reply section OR upload it at free uploading site e.g. www.dropbox.com or googledrive or onedrive and insert link here.
 
Upvote 0
This is formula. Why your file is very Slow?
I also work on VBA.
Excel Formula:
=TEXT((RIGHT([@Period],2)+8)*29,"mmmm") & " " & IF(RIGHT([@Period],2)*1<5,[@Year],[@Year]+1)
 
Upvote 0
Thanks that was quick! should I insert this at the the end of my VBA code? As I wanted it to run every time I open different sheets and run the macro.
 
Upvote 0
This is Macro:
VBA Code:
Sub Test()
 Dim i As Long, Lr As Long, Cell As Range, Sh1 As Worksheet, K As String
 Dim L As Long
 Lr = Range("Q" & Rows.Count).End(xlUp).Row
 Range("S2:S" & Lr).NumberFormat = "@"
 For i = 2 To Lr
 K = Application.WorksheetFunction.Text(Right(Range("R" & i).Value, 2) * 29, "mmmm")
 If Right(Range("R" & i).Value, 2) < 5 Then
  L = Range("Q" & i).Value
  Else
  L = Range("Q" & i).Value + 1
 End If
 Range("S" & i).Value = K & " " & L
 Next i
 
End Sub
 
Upvote 0
Sorry I forgot Change Column S to AM
VBA Code:
Sub Test()
 Dim i As Long, Lr As Long, Cell As Range, Sh1 As Worksheet, K As String
 Dim L As Long
 Lr = Range("Q" & Rows.Count).End(xlUp).Row
 Range("AM2:AM" & Lr).NumberFormat = "@"
 For i = 2 To Lr
 K = Application.WorksheetFunction.Text(Right(Range("R" & i).Value, 2) * 29, "mmmm")
 If Right(Range("R" & i).Value, 2) < 5 Then
  L = Range("Q" & i).Value
  Else
  L = Range("Q" & i).Value + 1
 End If
 Range("AM" & i).Value = K & " " & L
 Next i
 
End Sub
 
Upvote 0
Thanks I tried to paste this VBA code but nothing seems to happen in column AM when I click run?
 
Upvote 0
Are your Sheet was Activesheet?
For me working without problem.
 
Upvote 0
I tried it on this sheet i've uploaded here work template updated.xlsx

It does the first step of the macro but it doesn't add the date. Sorry I am not sure what you mean by active sheet I'm a beginner.
 
Upvote 0

Forum statistics

Threads
1,212,927
Messages
6,110,731
Members
448,294
Latest member
jmjmjmjmjmjm

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top