AnastasiyaRomanova's Profile
Expert
1055
Points

Questions
0

2

• Expert Asked on August 8, 2016 in

I have tested the following code for any input and it works fine.

```Sub ExtractString()
Dim iRow As Long, iChar As Integer, Char1 As String, Char2 As Boolean, Char3 As String
For iRow = 1 To 10
For iChar = 1 To Len(Cells(iRow, 1)) - 3
Char1 = Mid\$(Cells(iRow, 1), iChar, 1)
Char2 = IsNumeric(Mid\$(Cells(iRow, 1), iChar + 1, 3))
Char3 = Mid\$(Cells(iRow, 1), iChar + 4, 1)
If Char1 = "D" And Char2 = True Then
If Char3 = "F" Then
Cells(iRow, 2) = Mid\$(Cells(iRow, 1), iChar, 5): Exit For
Else
Cells(iRow, 2) = Mid\$(Cells(iRow, 1), iChar, 4): Exit For
End If
End If
Next
Next
End Sub
```

As you can see in the picture below, the string in column B is the output of my code and in column C is the output of PNRao’s code.

• 303 views
• Expert Asked on August 8, 2016 in

Here is an alternative code. Since I don’t know your layout data,  it’s hard for me to put sub routine InsertColumnDate and  RemoveColumnDate in a single program. So  you have to run these two sub-routines alternately, just make sure you run sub-routine InsertColumnDate first and  RemoveColumnDate afterward.

```Sub InsertColumnDate()

Dim StartDate As Date, EndDate As Date, Days As Integer, iDay As Integer
StartDate = "1/1/2016"

EndDate = "1/5/2016"

Days = EndDate - StartDate

Columns("A").Resize(, Days + 1).EntireColumn.Insert 'Change the Columns("A") accordingly
For iDay = 0 To Days

Cells(1, iDay + 1) = StartDate + iDay 'Change the row index 1 accordingly

Next iDay
End Sub

```

and

```
Sub RemoveColumnDate()

Dim iCol As Integer

On Error GoTo Finish

For iCol = 1 To 16384

iDel = iDel + 1

If Not Cells(1, iCol + 1) - Cells(1, iCol) = 1 Then 'Change the row index 1 accordingly

Exit For

End If

Next

Finish:

Columns("A").Resize(, iDel).EntireColumn.Delete 'Change the Columns("A") accordingly

End Sub

```
• 265 views