CODEWITHSUNDEEP
vbaexcel
SDROB
SDROB

Reputation: 125

Excel VBA code not pasting as date values

I have the following code creating new column "M" and pasting date values from column "L" to it after comma delimiter. Issue is not all values are pasted as numerical dates, although they appear as such. Causing me issues further down the line where I am creating a pivot and need to sort column headers by date. Also some dates only have date as yy instead of yyyy

With Sheets("DataSheet")

newLastRow = pasteRowIndex

If IsArray(v) Then
    .Columns(13).Insert Shift:=xlToRight
     For i = 1 To newLastRow
       If InStr(1, .Cells(i, "L"), ",") Then
        .Cells(i, "M").Value = Split(.Cells(i, "L"), ",")(1)

Not sure if this next line is correct

        Cells(i, "M").NumberFormat = "dd/mm/yyyy"
        End If
    Next i
End If

enter image description here

enter image description here

  Dim PSheet As Worksheet
  Dim DSheet As Worksheet
  Dim PCache As PivotCache
  Dim PTable As PivotTable
  Dim PRange As Range
  Dim LastRow1 As Long
  Dim LastCol As Long


  'Insert a New Blank Worksheet
  On Error Resume Next
  Application.DisplayAlerts = False
  Worksheets("PivotTable").Delete
  Sheets.Add Before:=ActiveSheet
  ActiveSheet.Name = "PivotTable"
  Application.DisplayAlerts = True
  'Switch off error masking
  On Error GoTo 0
  Set PSheet = Worksheets("PivotTable")
  Set DSheet = Worksheets("DataSheet")

  'With DSheet


  'Define Data Range
  LastRow1 = DSheet.Cells(Rows.Count, "B").End(xlUp).Row
  LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
  Set PRange = DSheet.Cells(1, "B").Resize(LastRow, 20)

  'Define Pivot Cache
  Set PCache = ActiveWorkbook.PivotCaches.Create _
      (SourceType:=xlDatabase, SourceData:=PRange)


  'Insert Blank Pivot Table
  Set PTable = PCache.CreatePivotTable _
      (TableDestination:=PSheet.Cells(1, 1), TableName:="MilestonePivotTable")


  'Insert Row Fields

  With PTable.PivotFields("Contract Identifier")
      .Orientation = xlRowField
      .Position = 1
  End With


  With PTable.PivotFields("SOW ID")
      .Orientation = xlRowField
      .Position = 2
  End With

  With PTable.PivotFields("Resource Name")
      .Orientation = xlRowField
      .Position = 3
  End With


  With PTable.PivotFields("Deliverable")
      .Orientation = xlRowField
      .Position = 4
  End With

  'Insert Column Fields
  With PTable.PivotFields("Milestone Date")
      .Orientation = xlColumnField
      .Position = 1
  End With

  ActiveSheet.PivotTables("MilestonePivotTable").PivotFields("Milestone 
  Date").AutoSort xlAscending, "Milestone Date"

  'Insert Data Field
    With PTable.PivotFields("Milestone Date")
               .Orientation = xlDataField
               .NumberFormat = "0"
           End With

  End Sub

Upvotes: 0

Views: 280

Answers (1)

Xabier
Xabier

Reputation: 7735

I've tried this and it seems to do what you are expecting, it will loop through the cell one character at a time and if it contains anything apart from / or numbers, it will remove them, then it will format the cell as a date:

Sub foo()
Dim StartString As String
Dim DateValue As String
Dim y As Integer
Dim LastRow As Long
With Sheets("DataSheet")
LastRow = .Cells(.Rows.Count, "L").End(xlUp).Row 'find the last row on column L
    .Columns(13).Insert Shift:=xlToRight 'add a new column to the right of column L
    For i = 1 To LastRow 'loop through rows
        If InStr(1, .Cells(i, "L"), ",") Then
            .Cells(i, "M").Value = Split(.Cells(i, "L"), ",")(1) 'split after comma
            StartString = .Cells(i, "L").Value
            DateValue = ""
            For y = 1 To Len(StartString) 'loop to remove unwanted characters
                Select Case Asc(Mid(StartString, y, 1))
                    Case 47 To 57
                        DateValue = DateValue & Mid(StartString, y, 1)
                End Select
            Next y
        .Cells(i, "M").Value = DateValue 'return the date
        .Cells(i, "M").NumberFormat = "dd/mm/yyyy" 'format it correctly
        End If
    Next i
End With
End Sub

If your code does insert the column and populates the cells with all the data after the comma, then you can simply include the following to your code and it should then work for you too:

StartString = .Cells(i, "L").Value
DateValue = ""
For y = 1 To Len(StartString) 'loop to remove unwanted characters
    Select Case Asc(Mid(StartString, y, 1))
    Case 47 To 57
        DateValue = DateValue & Mid(StartString, y, 1)
    End Select
Next y
.Cells(i, "M").Value = DateValue 'return the date
.Cells(i, "M").NumberFormat = "dd/mm/yyyy" 'format it correctly

Upvotes: 1

Related Questions