Public Sub subProcessImport()
Dim strCompany As String
Dim i As Long
Dim ii As Long
Dim arrStatement() As Variant
Dim rng As Range
Dim s As String
Dim intRow As Integer
Dim arrString() As String
Dim arrVariant() As Variant
Dim arrLines() As String
Dim WsCustomers As Worksheet
Dim WsStatement As Worksheet
Dim strAccount As String
Dim strVendor As String
Dim lngStatementRow As Long
ActiveWorkbook.Save
Set WsCustomers = Worksheets("Customers")
With WsCustomers
With .Cells
.Clear
End With
.Range("A1:F1").Value = Array("Customer", "Address 1", "Address 2", "Address 3", "Address 4", "Account")
End With
Set WsStatement = Worksheets("StatementLines")
With WsStatement
With .Cells
.Clear
End With
.Range("A1:E1").Value = Array("Account", "INV NBR", "INV DATE", "AMOUNT", "DUE DATE")
End With
strCompany = Range("A1").Value
intRow = 2
lngStatementRow = 2
For Each rng In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
' First line of individual statement.
If Trim(rng.Value) = strCompany Then
s = s & vbCrLf & rng.Value
i = i + 1
End If
' Customer number.
If InStr(1, Trim(rng.Value), "CUST NBR - ", vbTextCompare) > 0 Then
arrString = Split(rng.Value, " ")
With WsCustomers
.Cells(intRow, 1).Value = Trim(Replace(rng.Value, "CUST NBR - " & arrString(UBound(arrString)), "", 1))
strAccount = arrString(UBound(arrString))
.Cells(intRow, 6).Value = arrString(UBound(arrString))
End With
arrVariant = rng.Offset(1, 0).Resize(6)
For i = LBound(arrVariant) To UBound(arrVariant)
If Trim(arrVariant(i, 1)) <> "" Then
WsCustomers.Cells(intRow, i + 1).Value = arrVariant(i, 1)
Else
Exit For
End If
Next i
intRow = intRow + 1
End If
If Left(rng.Value, 11) = "VENDOR NAME" Then
arrVariant = rng.Offset(1, 0).Resize(30)
For i = LBound(arrVariant) To UBound(arrVariant)
If Trim(arrVariant(i, 1)) = "--------------------" Then
Exit For
End If
Do While InStr(1, arrVariant(i, 1), " ", vbTextCompare) > 0
arrVariant(i, 1) = Replace(arrVariant(i, 1), " ", " ", 1)
Loop
arrLines = Split(arrVariant(i, 1), " ")
strVendor = ""
For ii = LBound(arrLines) To UBound(arrLines) - 4
strVendor = strVendor & " " & arrLines(ii)
Next ii
s = ""
WsStatement.Cells(lngStatementRow, 1).Value = strAccount
For ii = UBound(arrLines) - 3 To UBound(arrLines)
s = s & "," & arrLines(ii)
Next ii
WsStatement.Range("A" & lngStatementRow & ":E" & lngStatementRow).Value = Split(strAccount & s, ",")
lngStatementRow = lngStatementRow + 1
Next i
End If
Next rng
Call subFormatSheet(WsCustomers)
Call subFormatSheet(WsStatement)
MsgBox "Statement trext file has been processed.", vbOKOnly, "Confirmation"
End Sub
Public Sub subFormatSheet(Ws As Worksheet)
With Ws.Range("A1").CurrentRegion
.Font.Size = 14
.Font.Name = "Arial"
With .Rows(1)
.Font.Bold = True
.Interior.Color = RGB(217, 217, 217)
End With
.VerticalAlignment = xlCenter
.EntireColumn.AutoFit
With .Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = vbBlack
End With
End With
End Sub
and I am so grateful too!! I will not be able to do that until later tonight. It is blocked here at work and I can do it when I get home from my PC.
