Page tree

Welcome to FreeSoftwareServers Confluence Wiki

Skip to end of metadata
Go to start of metadata

This assumes a few things:

You need to know `SeqStart` and what type of data you want in the end and how to get it (Left of String, Right of String or using RegEx).

  • I originally had just Regex, then just right before I realized I needed to have Booleans and set the accordingly to input data format and desired output. 
  • I purposefully didn't add any "error handling"/defaults to force Booleans to be set.


Public Sub TestNumFromStr()

 Dim SeqStart As String, SeqInt As Integer, SeqEnd As String, AlphaNumericStr As String, NumberFromStr As Long, NumPos As Integer
 
 Scenario = "LeftNum"
 
 Select Case Scenario
 
 Case "RightNum"
 
  'AlphaNumericStr = "A1007"
  AlphaNumericStr = "A1A420"
  
  Debug.Print "AlphaNumericStr = " & AlphaNumericStr
    
  NumPos = LastNumericPositionInString(AlphaNumericStr, True, False)
  Debug.Print "NumPos = " & NumPos
  
  NumberFromStr = NumFromStr(AlphaNumericStr, True)

  Debug.Print "NumberFromStr = " & NumberFromStr
  
 Case "LeftNum"
 
  AlphaNumericStr = "10 (Test)"
 
  Debug.Print "AlphaNumericStr = " & AlphaNumericStr
 
  NumPos = LastNumericPositionInString(AlphaNumericStr, False, True)
  Debug.Print "NumPos = " & NumPos
  
  NumberFromStr = NumFromStr(AlphaNumericStr, False, True)
  Debug.Print "NumberFromStr = " & NumberFromStr
  
 Case "RegExNum"
  
  AlphaNumericStr = "A1A420"
  
  Debug.Print "AlphaNumericStr = " & AlphaNumericStr
  
  NumberFromStr = NumFromStr(AlphaNumericStr, False, False, True)
  Debug.Print "NumberFromStr = " & NumberFromStr
  
 Case "EndXLStr"
 
  SeqInt = 42
  'SeqStart = "A1007"
  SeqStart = "A1A420"
 
  SeqEnd = EndOfXlFillSeries(SeqStart, SeqInt)
  Debug.Print "SeqStart = " & SeqStart
  Debug.Print "SeqInt = " & SeqInt
  
  Debug.Print "SeqEnd (EndOfXlFillSeries)= " & SeqEnd
 
 Case "SeqInt"
 
  'SeqStart = "A1007"
  SeqStart = "A1A420"
 
  'SeqEnd = "A1600"
  SeqEnd = "A1A500"
 
  SeqInt = GetSeqInt(SeqStart, SeqEnd)
  Debug.Print "SeqStart = " & SeqStart
  Debug.Print "SeqEnd = " & SeqEnd
  Debug.Print "SeqInt (GetSeqInt)= " & SeqInt
 
 End Select
 
End Sub
Public Function LastNumericPositionInString(Str As String, Optional StartRightMoveLeftBool As Boolean, Optional StartLeftMoveRightBool As Boolean) As Integer
 Dim StrLength As Integer, Pos As Integer, PosStr As String, StepInc As Integer, i As Integer
 StrLength = Len(Str)

 If StartRightMoveLeftBool = True Then
  StepInc = -1
  EndPos = StrLength
  For i = EndPos To 1 Step -1
   PosStr = Mid(Str, i, 1)
   If Not IsNumeric(PosStr) Then
    LastNumericPositionInString = i + 1
    Exit Function
   End If
  Next
 ElseIf StartLeftMoveRightBool = True Then
  StepInc = 1
  EndPos = StrLength
  For i = 1 To 10 Step 1
   PosStr = Mid(Str, i, 1)
   If Not IsNumeric(PosStr) Then
    LastNumericPositionInString = i - 1
    Exit Function
   End If
  Next
 End If

End Function
Public Function NumFromStr(Str As String, Optional StartRightMoveLeftBool As Boolean, Optional StartLeftMoveRightBool As Boolean, Optional RegExBool As Boolean) As Long
 Dim NumStartPos As Integer
 Str = Trim(Str)
 If StartRightMoveLeftBool = True Then
  NumStartPos = LastNumericPositionInString(Str, StartRightMoveLeftBool, StartLeftMoveRightBool)
  NumFromStr = Right(Str, Len(Str) - NumStartPos + 1)
 ElseIf StartLeftMoveRightBool = True Then
  NumStartPos = LastNumericPositionInString(Str, StartRightMoveLeftBool, StartLeftMoveRightBool)
  NumFromStr = Left(Str, NumStartPos)
 ElseIf RegExBool = True Then
  Dim objRegex
  Set objRegex = CreateObject("vbscript.regexp")
  With objRegex
   .Global = True
   .Pattern = "[^\d]+"
   NumFromStr = .Replace(Str, vbNullString)
  End With
 End If
End Function
Public Function EndOfXlFillSeries(SeqStart As String, SeqInt As Integer) As String
 Dim DestSheet As Worksheet, StartWS As Worksheet
 Set StartWS = Worksheets(ActiveSheet.Name)
 WorksheetCreateDelIfExists ("XLFillSeriesTmp")
 Set DestSheet = Worksheets("XLFillSeriesTmp")
 With DestSheet.Range("A1")
  .Value = UCase(SeqStart)
  If SeqInt > 1 Then
   .AutoFill Destination:=DestSheet.Range("A1").Resize(SeqInt), Type:=xlFillSeries ' Will cause error if only 1 sample sequence
  Else
   EndOfXlFillSeries = SeqStart
  End If
 End With
 Dim lRow As Integer
 lRow = lRowOfCol(1)
 EndOfXlFillSeries = DestSheet.Range("A" & lRow).Value
 Call WorksheetDelete(DestSheet)
 StartWS.Activate
End Function
Public Function GetSeqInt(SeqStart As String, SeqEnd As String) As Long
 Dim EndXlInt As Long, StartXLInt As Long
 StartXLInt = NumFromStr(SeqStart, True)
 EndXlInt = NumFromStr(SeqEnd, True)
 GetSeqInt = EndXlInt - StartXLInt + 1
End Function
Sub TestAlpha()
 Dim Str As String, AlphaOnlyStr As String, AlphaType As String

 AlphaType = "RegexAlpha"

 Select Case AlphaType

  Case "LeftAlpha"
   Str = "A100"
   AlphaOnlyStr = AlphaFromStr(Str, False, True, False)

  Case "RightAlpha"
   Str = "100A"
   AlphaOnlyStr = AlphaFromStr(Str, True, False, False)

  Case "RegexAlpha"
   Str = "A100A"
   AlphaOnlyStr = AlphaFromStr(Str, False, False, True)

 End Select
 Debug.Print "Str = " & Str
 Debug.Print "AlphaOnlyStr = " & AlphaOnlyStr
End Sub
Public Function AlphaFromStr(Str As String, Optional StartRightMoveLeftBool As Boolean, Optional StartLeftMoveRightBool As Boolean, Optional RegExBool As Boolean) As String
 Dim NumStartPos As Integer
 Str = Trim(Str)
 NumStartPos = LastNumericPositionInString(Str, StartLeftMoveRightBool, StartRightMoveLeftBool)
 If StartRightMoveLeftBool = True Then
  AlphaFromStr = Right(Str, Len(Str) - NumStartPos)
 ElseIf StartLeftMoveRightBool = True Then
  AlphaFromStr = Left(Str, NumStartPos - 1)
 ElseIf RegExBool = True Then
  Dim objRegex
  Set objRegex = CreateObject("vbscript.regexp")
  With objRegex
   .Global = True
   .Pattern = "[^\D]+"
   AlphaFromStr = .Replace(Str, vbNullString)
  End With
 End If
End Function
Function IsAlpha(Str As String) As Boolean
    IsAlpha = Len(Str) And Not Str Like "*[!a-zA-Z]*"
End Function
  • No labels