Split the data into Different Format

[Abhijeet]

String In Column A Pull Numbers Column D onwards Please see attach file then u can understand

 

[Marc L]

Seems you don't understand how to use Split function, read (and try)
text functions in VBA inner help like InStr, InStrRev and Mid …
​

 

[Abhijeet]

Hi Mark L i am tried but i can't do this with my Expected Result format

 

[Marc L]

And I can do nothing without your analyse of what to do …
​

 

[Abhijeet]

Please tell me in this code what changes need to do

Public Sub PullData()
  Const MONTHABBREVIATION = "Dec"
  Const SATURDAYABBREVIATION = "Sat"
  Const SUNDAYABBREVIATION = "Sun"
  Const NIGHT = "Night"
  
  Const ORDINALENDINGS = "st.nd.rd.th."
  Const MONTHNUMBERS = "01.02.03.04.05.06.07.08.09.10.11.12."
  Const MONTHSTRINGS = "JanFebMarAprMayJunJulAugSepOctNovDec"
  Const NUMBERS = "0123456789."
  
  Const NUMBEROFCOLUMNS = 4
  Const HEADER = "Date,Sat,Sun,Night"
  
  Dim inputstr As String, datestr As String, satstr As String, sunstr As String, nightstr As String  '
  Dim inputpos As Integer, mthpos As Integer, satpos As Integer, sunpos As Integer, nightpos As Integer  '
  Dim dateval As Integer
  Dim satval As Double, sunval As Double, nightval As Double  '
  
  Dim dataarray As Variant
  Dim datarange As Range, cell As Range
  
  With Application
  .EnableEvents = False
  .ScreenUpdating = False
  End With
  
  ThisWorkbook.Worksheets("Sheet1").Activate
  With ActiveSheet.Range("StartCell")
  .Resize(, NUMBEROFCOLUMNS).Value = Split(HEADER, ",")
  .Offset(1).Activate
  
  Set datarange = ActiveSheet.Range("Table1")
  outputcounter = 0
  For Each cell In datarange
  satval = 0
  nightval = 0
  sunval = 0
  inputstr = cell.Value
  
  mthpos = InStr(1, inputstr, MONTHABBREVIATION)
  If mthpos > 0 Then
  datestr = Mid(inputstr, IIf(mthpos > 10, mthpos - 5, 1), 2)
  If VBA.IsNumeric(Right(datestr, 1)) Then
  dateval = Val(datestr)
  Else
  dateval = Val(Left(datestr, 1))
  End If
  End If
  
  monthnum = InStr(1, MONTHSTRINGS, MONTHABBREVIATION)
  mth = Val(Mid(MONTHNUMBERS, monthnum, 2))
  dt = VBA.DateSerial(VBA.Year(VBA.Date), mth, dateval)
  
  satpos = InStr(mthpos + 6, inputstr, SATURDAYABBREVIATION) - 1
  If satpos > 0 Then
  i = 1
  Do While InStr(1, NUMBERS, Mid(inputstr, satpos - i, 1)) > 0
  i = i + 1
  Loop
  satstr = Mid(inputstr, satpos - i, i)
  satval = Val(Trim(satstr))
  Else
  satpos = mthpos
  End If
  
  nightpos = InStr(satpos + 6, inputstr, NIGHT) - 1
  If nightpos > 0 Then
  i = 1
  Do While InStr(1, NUMBERS, Mid(inputstr, nightpos - i, 1)) > 0
  i = i + 1
  Loop
  nightstr = Mid(inputstr, nightpos - i, i)
  nightval = Val(Trim(nightstr))
  Else
  nightpos = satpos
  End If
  
  sunpos = InStr(nightpos + 6, inputstr, SUNDAYABBREVIATION) - 1
  If sunpos > 0 Then
  i = 1
  Do While InStr(1, NUMBERS, Mid(inputstr, sunpos - i, 1)) > 0
  i = i + 1
  Loop
  sunstr = Mid(inputstr, sunpos - i, i)
  sunval = Val(Trim(sunstr))
  End If
  
  With ActiveCell
  .Offset(outputcounter, 0).Value = dt
  .Offset(outputcounter, 1).Value = satval
  .Offset(outputcounter, 2).Value = sunval
  .Offset(outputcounter, 3).Value = nightval
  outputcounter = outputcounter + 1
  End With
  Next
  End With
  
  With Application
  .EnableEvents = True
  .ScreenUpdating = True
  End With
End Sub

 

[Marc L]

Well, I don't waste my time to attempt to make a retro-analyse
from this kind of gas factory code !

If this code is in relation to the need
(I guess it needs less than 40 codelines),
it's better you explain the technical point where you have a difficulty.
​