AnastasiyaRomanova's Profile
Expert
1055
Points

Questions
0

Answers
2

  • Expert Asked on August 8, 2016 in VBA.

    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.

    RE: VBA to extract one alphabet 3 numbers and one alphabet from String

    • 303 views
    • 2 answers
    • 0 votes
  • 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
    • 3 answers
    • 0 votes