Sub Compile()
Dim Sep As String
Dim Pagename As String
Dim WholeLine As String
Dim WholeLine2 As String
Dim LastWholeLine As String
Dim NextWholeLine As String
Dim NewWholeline As String
Dim FNum As Integer
Dim RowNdx As Long
Dim ColNdx As Integer
Dim ColNdx2 As Integer
Dim StartRow As Long
Dim EndRow As Long
Dim StartCol As Integer
Dim StartCol2 As Integer
Dim EndCol As Integer
Dim EndCol2 As Integer
Dim CellValue As String
Dim Count As Integer
Dim RowNdx2 As Long
Dim StartRow2 As Long
Dim EndRow2 As Long
Dim CellValue2 As String
Dim TempNum As Integer
Dim TempLine As String
Sep = "|"
StartRow = 13
StartCol = 16
StartCol2 = 16
EndCol = 22
EndCol2 = 22
StartRow2 = 13
EndRow2 = 300
YesNo = MsgBox("Are you sure?", vbYesNo, "Saving File")
Select Case YesNo
Case vbYes
For RowNdx2 = StartRow2 To EndRow2
CellValue2 = Cells(RowNdx2, 16).Text
If CellValue2 = "" Then
RowNdx2 = RowNdx2 - 1
EndRow = RowNdx2
GoTo skip1
End If
Next RowNdx2
skip1:
Pagename = Range("c31") + Range("c30") & ".txt" ' location and name of saved file
Open Pagename For Output As #1
For RowNdx = StartRow + Count To EndRow
Cells(45 + RowNdx, 1).Value = RowNdx
Cells(45 + RowNdx, 3).Value = Count
Count = 0
WholeLine = ""
NextWholeLine = ""
For ColNdx = StartCol To EndCol
If Cells(RowNdx, ColNdx).Value = "" Then
CellValue = Chr(34) & Chr(34)
Else
CellValue = Cells(RowNdx, ColNdx).Text
End If
WholeLine = WholeLine & CellValue & Sep
Next ColNdx
LastWholeLine = Mid(WholeLine, InStr(1, WholeLine, Sep) + 1, Len(WholeLine))
For RowNdx2 = StartRow + 1 To EndRow
Cells(45 + RowNdx2, 2).Value = RowNdx2
WholeLine2 = ""
For ColNdx2 = StartCol2 To EndCol2
If Cells(RowNdx2, ColNdx2).Value = "" Then
Close #1
GoTo skip2
Else
CellValue = Cells(RowNdx2, ColNdx2).Text
End If
WholeLine2 = WholeLine2 & CellValue & Sep
Next ColNdx2
NextWholeLine = Mid(WholeLine2, InStr(1, WholeLine2, Sep) + 1, Len(WholeLine2))
If LastWholeLine = NextWholeLine Then
Count = Count + 1
If NewWholeline = "" Then
TempNum = Val(Left(LastWholeLine, InStr(1, LastWholeLine, Sep) - 1)) + Val(Left(NextWholeLine, InStr(1, NextWholeLine, Sep) - 1))
NewWholeline = Left(WholeLine, InStr(1, WholeLine, Sep) - 1) + "," + Left(WholeLine2, InStr(1, WholeLine2, Sep) - 1) + Sep + Str(TempNum) + Sep + Mid(NextWholeLine, InStr(1, NextWholeLine, Sep) + 1, Len(NextWholeLine))
Else
TempLine = Mid(NewWholeline, InStr(1, NewWholeline, Sep) + 1, Len(NewWholeline))
TempNum = Val(Left(TempLine, InStr(1, TempLine, Sep) - 1)) + Val(Left(NextWholeLine, InStr(1, NextWholeLine, Sep) - 1))
NewWholeline = Left(NewWholeline, InStr(1, NewWholeline, Sep) - 1) + "," + Left(WholeLine2, InStr(1, WholeLine2, Sep) - 1) + Sep + Str(TempNum) + Sep + Mid(NextWholeLine, InStr(1, NextWholeLine, Sep) + 1, Len(NextWholeLine))
End If
End If
Print #1, NewWholeline
Next RowNdx2
NewWholeline = ""
Next RowNdx
Close #1
MsgBox ("Your file has been saved")
Case vbNo
GoTo skip2
End Select
skip2:
Application.Run "refreshlist"
End Sub
Bookmarks