Option Explicit
Dim lngStart As Long
Dim lngNumber As Long
Dim strRet As String
Sub EF982512_Determining_Ranges()
Dim lngCounter As Long
Dim strFunc As String
Dim var As Variant
Dim lngArray As Long
Dim lngWrite As Long
lngStart = 1
For lngCounter = 1 To Range("A" & Rows.Count).End(xlUp).Row + 1
If Cells(lngCounter, "A").Value = "" Then
lngCounter = Cells(lngCounter, "A").End(xlDown).Offset(-1, 0).Row
If Len(strFunc) > 0 Then
Select Case strFunc
Case "DE"
EF982512_DE
Case "IT"
EF982512_IT
Case "GB"
EF982512_GB
Case "FR"
EF982512_FR
Case Else
End Select
If Len(strRet) > 0 Then
var = Split(strRet, vbCrLf)
For lngArray = LBound(var) To UBound(var)
lngWrite = lngWrite + 1
Cells(lngWrite, "B").Value = "'" & var(lngArray)
Next lngArray
End If
End If
lngWrite = lngWrite + 1
lngNumber = 0
lngStart = lngCounter + 1
strFunc = vbNullString
Else
lngNumber = lngNumber + 1
Select Case LCase(Cells(lngCounter, "A").Value)
Case "deutschland"
strFunc = "DE"
Case "italy"
strFunc = "IT"
Case "france"
strFunc = "FR"
Case "united kingdom"
strFunc = "GB"
End Select
End If
Next lngCounter
End Sub
Sub EF982512_DE()
Dim lngCounter As Long
Dim strOut As String
Dim var As Variant
strOut = Cells(lngStart, "A").Value & vbCrLf
For lngCounter = 1 To lngNumber - 1
If lngCounter = 3 Then
strOut = strOut & "DE" & vbCrLf
Else
If InStr(1, Cells(lngStart, "A").Offset(lngCounter, 0).Value, Chr(160)) > 0 Then
var = Split(Cells(lngStart, "A").Offset(lngCounter, 0).Value, Chr(160))
strOut = strOut & var(0) & vbCrLf & var(1) & vbCrLf
ElseIf InStr(1, Cells(lngStart, "A").Offset(lngCounter, 0).Value, " ") > 0 Then
var = Split(Cells(lngStart, "A").Offset(lngCounter, 0).Value, " ")
strOut = strOut & var(0) & vbCrLf & var(1) & vbCrLf
End If
End If
Next lngCounter
strOut = strOut & Replace(Cells(lngStart, "A").Offset(lngNumber - 1, 0).Value, "Telefon:", "")
If Len(strOut) < 7 Then
MsgBox "Didnīt get enough information"
strRet = ""
Else
strRet = strOut
End If
End Sub
Sub EF982512_IT()
Dim lngCounter As Long
Dim strOut As String
Dim var As Variant
strOut = Cells(lngStart, "A").Value & vbCrLf
If InStr(1, Cells(lngStart + 1, "A").Value, Chr(160)) > 0 Then
var = Split(Cells(lngStart + 1, "A").Value, Chr(160))
If UBound(var) = 1 Then
strOut = strOut & var(0) & vbCrLf & var(1) & vbCrLf
Else
For lngCounter = LBound(var) To UBound(var) - 1
strOut = strOut & var(lngCounter) & " "
Next lngCounter
strOut = Trim(strOut) & var(UBound(var)) & vbCrLf
End If
ElseIf InStr(1, Cells(lngStart + 1, "A").Value, " ") > 0 Then
var = Split(Cells(lngStart + 1, "A").Value, " ")
If UBound(var) = 1 Then
strOut = strOut & var(0) & vbCrLf & var(1) & vbCrLf
Else
For lngCounter = LBound(var) To UBound(var) - 1
strOut = strOut & var(lngCounter) & " "
Next lngCounter
strOut = Trim(strOut) & vbCrLf & var(UBound(var)) & vbCrLf
End If
End If
strOut = strOut & Cells(lngStart + 5, "A").Value & vbCrLf
strOut = strOut & Cells(lngStart + 4, "A").Value & vbCrLf
strOut = strOut & "IT" & vbCrLf
strOut = strOut & Replace(Cells(lngStart + 7, "A").Value, "Phone:", "")
If Len(strOut) < 7 Then
MsgBox "Didnīt get enough information"
strRet = ""
Else
strRet = strOut
End If
End Sub
Sub EF982512_GB()
Dim lngCounter As Long
Dim strOut As String
Dim var As Variant
strOut = Cells(lngStart, "A").Value & vbCrLf
If InStr(1, Cells(lngStart + 1, "A").Value, Chr(160)) > 0 Then
var = Split(Cells(lngStart + 1, "A").Value, Chr(160))
If UBound(var) = 1 Then
strOut = strOut & var(1) & vbCrLf & var(0) & vbCrLf
Else
For lngCounter = 1 To UBound(var)
strOut = strOut & var(lngCounter) & " "
Next lngCounter
strOut = Trim(strOut) & vbCrLf & var(0) & vbCrLf
End If
ElseIf InStr(1, Cells(lngStart + 1, "A").Value, " ") > 0 Then
var = Split(Cells(lngStart + 1, "A").Value, " ")
If UBound(var) = 1 Then
strOut = strOut & var(1) & vbCrLf & var(0) & vbCrLf
Else
For lngCounter = 1 To UBound(var)
strOut = strOut & var(lngCounter) & " "
Next lngCounter
strOut = Trim(strOut) & vbCrLf & var(0) & vbCrLf
End If
End If
strOut = strOut & Cells(lngStart + 5, "A").Value & vbCrLf
strOut = strOut & Cells(lngStart + 2, "A").Value & vbCrLf
strOut = strOut & "GB" & vbCrLf
strOut = strOut & Replace(Cells(lngStart + 7, "A").Value, "Phone:", "")
If Len(strOut) < 7 Then
MsgBox "Didnīt get enough information"
strRet = ""
Else
strRet = strOut
End If
End Sub
Sub EF982512_FR()
Dim lngCounter As Long
Dim strOut As String
Dim var As Variant
var = Split(Cells(lngStart, "A").Value, " ")
strOut = var(UBound(var)) & " " & var(LBound(var)) & vbCrLf
If InStr(1, Cells(lngStart + 1, "A").Value, Chr(160)) > 0 Then
var = Split(Cells(lngStart + 1, "A").Value, Chr(160))
If UBound(var) = 1 Then
strOut = strOut & var(1) & vbCrLf & var(0) & vbCrLf
Else
For lngCounter = 1 To UBound(var)
strOut = strOut & var(lngCounter) & " "
Next lngCounter
strOut = Trim(strOut) & vbCrLf & var(0) & vbCrLf
End If
ElseIf InStr(1, Cells(lngStart + 1, "A").Value, " ") > 0 Then
var = Split(Cells(lngStart + 1, "A").Value, " ")
If UBound(var) = 1 Then
strOut = strOut & var(1) & vbCrLf & var(0) & vbCrLf
Else
For lngCounter = 1 To UBound(var)
strOut = strOut & var(lngCounter) & " "
Next lngCounter
strOut = Trim(strOut) & vbCrLf & var(0) & vbCrLf
End If
End If
If InStr(1, Cells(lngStart + 2, "A").Value, Chr(160)) > 0 Then
var = Split(Cells(lngStart + 2, "A").Value, Chr(160))
If UBound(var) = 1 Then
strOut = strOut & var(0) & vbCrLf & var(1) & vbCrLf
Else
strOut = strOut & var(0) & vbCrLf
For lngCounter = 1 To UBound(var)
strOut = strOut & var(lngCounter) & " "
Next lngCounter
End If
ElseIf InStr(1, Cells(lngStart + 1, "A").Value, " ") > 0 Then
var = Split(Cells(lngStart + 1, "A").Value, " ")
If UBound(var) = 1 Then
strOut = strOut & var(0) & vbCrLf & var(1) & vbCrLf
Else
strOut = strOut & var(0) & vbCrLf
For lngCounter = 1 To UBound(var)
strOut = strOut & var(lngCounter) & " "
Next lngCounter
End If
End If
strOut = Trim(strOut) & vbCrLf & "FR" & vbCrLf
strOut = strOut & Replace(Cells(lngStart, "A").Offset(lngNumber - 1, 0).Value, "Téléphone:", "")
If Len(strOut) < 7 Then
MsgBox "Didnīt get enough information"
strRet = ""
Else
strRet = strOut
End If
End Sub
Code should do fine with the samples delievered but Iīm afraid no program will be able to detect if the First Name is listed before or after the Surname without a huge list to compare to and decide from there if the lower or upper bound of the array should be taken for the First Name. Code for
Bookmarks