Retroshift
Board Regular
- Joined
- Sep 20, 2016
- Messages
- 119
- Office Version
- 2019
- Platform
- Windows
Hi,
I have this macro (see below - code scripting credited to member rlv01) and I would like to add a subroutine which crops all the values of column O to 10 characters only.
So I want to only keep the first 10 characters of the data in every cell of the single column O. For example: if the macro imports "16/05/2022 11:00:00" into a cell in column O, the amount of characters should get cropped down to only the date (10 characters in this case) and not the time, so "16/05/2022".
And when a value of "16/05/2022" gets imported (merely the date (10 characters)), it is fine and it can stay there without any VBA action to it.
I am not a VBA virtuoso so any help with the scripting would be appreciated.
I have this macro (see below - code scripting credited to member rlv01) and I would like to add a subroutine which crops all the values of column O to 10 characters only.
So I want to only keep the first 10 characters of the data in every cell of the single column O. For example: if the macro imports "16/05/2022 11:00:00" into a cell in column O, the amount of characters should get cropped down to only the date (10 characters in this case) and not the time, so "16/05/2022".
And when a value of "16/05/2022" gets imported (merely the date (10 characters)), it is fine and it can stay there without any VBA action to it.
I am not a VBA virtuoso so any help with the scripting would be appreciated.
VBA Code:
Sub RefreshClearCopyColumnsData()
Dim wkBk As Workbook, wkBk2 As Workbook
Dim wkSht As Worksheet, wkSht2 As Worksheet
Dim FullPathName As String
Dim ColArr, ColLetter
Dim rng As Range
Dim I As Long, lastrow As Long
'First refresh the open workbook to update all the values
Set wkBk = ActiveWorkbook
wkBk.RefreshAll
'Then clear the contents of the worksheet in the open workbook
Set wkSht = wkBk.Worksheets("Sheet1")
wkSht.UsedRange.ClearContents
'Then get columns data from closed workbook into open workbook
'Get path and Closed Workbook filename from (indirect?) cell A5 in open workbook
FullPathName = wkBk.Worksheets("Sheet2").Range("A5").Value
With CreateObject("Scripting.FileSystemObject")
If Not .FileExists(FullPathName) Then
MsgBox "File does not exist - abort"
Exit Sub
End If
End With
Set wkBk2 = Workbooks.Open(FullPathName)
Set wkSht2 = wkBk2.Sheets(1)
lastrow = wkSht2.UsedRange.Rows.Count
'Specify the columns until the last row with data
ColArr = Array("A", "O", "R", "V", "AD", "AG", "AH")
For Each ColLetter In ColArr
With wkSht2
I = I + 1
If I = 1 Then
Set rng = Application.Intersect(.UsedRange, .Range(ColLetter & "1", .Range(ColLetter & lastrow)))
Else
Set rng = Application.Union(rng, Application.Intersect(.UsedRange, .Range(ColLetter & "1", .Range(ColLetter & lastrow))))
End If
End With
Next ColLetter
wkSht.Activate
rng.Copy wkSht.Range("C2")
wkBk2.Close False
'Add message box
MsgBox "Data successfully imported"
End Sub
