Cant determine a cells contents

[austenr]

In the attached file I need to identify the contents of a cell contaiining the text values of -2, -3 etc. All of these values will not be present at all times but when they are encountered, the result needs to be what is on the right of the spreadsheet. Any help would most definatly be appreciated.

[Jacob Hilderbrand]

Can you clarify what you want to do? The spreadsheet was not much help. What range should I be looking at in the workbook?

[austenr]

The range is A1:F65536. Need a way to loop trough and identify when the group # changes. That is found in B1 on the example. This will always be the column for this identifier and the numbers can range from -1 to -40. When you encounter this range, skip a row and begin writing the rows until you reach the row with the +---------. When that happens, then write the totals that are found inside those lines. There could be three total lines or only one. Then repeat steps above until EOF. HTH

[geekgirlau]

OK, so let me get this straight ...

The task is to capture the summary section for each Group. The Group number will be in column B, and will be a negative value between -1 and -40. In your sample file, the totals to be captured for Group -2 would be the $ values in E6 and E7.

A couple of questions:

1. When you say "write" the totals, where did you want them written to? In what format?
2. Did you want all the values in the summary section, or the sum of all the values?

[austenr]

Just need to extract the rows as is to a format that is readable. The outcome should be as it is on the right side of the spreadsheet

[geekgirlau]

Try this (not pretty, but it should work)

Sub FormatSummary()
Dim lngRowLast As Long
' find last row
lngRowLast = Range("A1").SpecialCells(xlCellTypeLastCell).Row
 
' replace lines in summary
Cells.Replace What:= _
"+--------------------------------------------------------------------------------------------------+" _
, Replacement:="", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:= _
False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="?", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Range("A1").Select
' loop thru text
Do
' capture start of group and group summary
Select Case ActiveCell.Offset(0, 1).Value
Case -40 To -1
Selection.Delete Shift:=xlToLeft
ActiveCell.Offset(1, 0).Select
Selection.EntireRow.Insert
End Select
Select Case ActiveCell.Offset(0, 2).Value
Case -40 To -1
Range(Selection, Selection.Offset(0, 1)).Delete Shift:=xlToLeft
ActiveCell.Offset(1, 0).Select
Selection.EntireRow.Insert
End Select
' remove 2 consecutive blank rows
If ActiveCell.Formula = "" And ActiveCell.Offset(-1, 0).Formula = "" Then
Selection.EntireRow.Delete
lngRowLast = lngRowLast - 1
Else
ActiveCell.Offset(1, 0).Select
End If
Loop Until ActiveCell.Row > lngRowLast
End Sub

[austenr]

Errors out on this line:

If ActiveCell.Formula = "" And ActiveCell.Offset(-1, 0).Formula = "" Then

[austenr]

Application defined or Object defined error

[BlueCactus]

That error is usually caused by trying to tell Excel to do something it cannot, typically because a parameter is out of bounds.

Without looking through the code, I would guess you're trying to access a cell with Offset(-1,0) from a cell in row A. This would cause an error because you are asking for row zero which doesn't exist.

[geekgirlau]

If your sample data is representative, cell A1 should never have a blank value ...

[austenr]

I had to change the file layout to remove the 2 blank lines. Now the file contains no blank lines. I commented out the If statement at the bottom of the code that removes two blank rows and ran this routine but it stays in a constant loop. Can anyone help? Thanks

Sub FormatSummary()
    Dim lngRowLast As Long
' find last row
    lngRowLast = Range("A1").SpecialCells(xlCellTypeLastCell).Row
' replace lines in summary
    Cells.Replace What:= _
    "+--------------------------------------------------------------------------------------------------+" _
    , Replacement:="", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:= _
    False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="?", Replacement:="", LookAt:=xlPart, SearchOrder:= _
    xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Range("A1").Select
' loop thru text
    Do
         ' capture start of group and group summary
        Select Case ActiveCell.Offset(0, 1).Value
        Case -40 To -1
            Selection.Delete Shift:=xlToLeft
            ActiveCell.Offset(1, 0).Select
            Selection.EntireRow.Insert
        End Select
Select Case ActiveCell.Offset(0, 2).Value
        Case -40 To -1
            Range(Selection, Selection.Offset(0, 1)).Delete Shift:=xlToLeft
            ActiveCell.Offset(1, 0).Select
            Selection.EntireRow.Insert
        End Select
' remove 2 consecutive blank rows
        If ActiveCell.Formula = "" And ActiveCell.Offset(-1, 0).Formula = "" Then
            Selection.EntireRow.Delete
            lngRowLast = lngRowLast - 1
        Else
ActiveCell.Offset(1, 0).Select
        End If
    Loop Until ActiveCell.Row > lngRowLast
End Sub

[geekgirlau]

It sounds like the procedure is struggling to determine when to stop. I'd reinstate the delete rows section, but change this line ...

' remove 2 consecutive blank rows
If ActiveCell.Formula = "" And ActiveCell.Offset(-1, 0).Formula = "" Then

... to this

' remove 2 consecutive blank rows
If ActiveCell.Formula = "" And ActiveCell.Offset(1, 0).Formula = "" Then

[Bob Phillips]

It sounds like the procedure is struggling to determine when to stop. I'd reinstate the delete rows section, but change this line ...

I would have thought the problem is all of the selecting/activating that is going on within the loop, and moving the last row continually, so where is lngRowLast pointing at any time?.

This code must be incredibly hard to debug. I would think hard about a re-design, to simplify the logic.

[austenr]

Well geekgirlau helped out. It is her code. It is the way the file is imported that causes the problem. It is a text file imported as text to columns. The problem is that there are soo many special characters in there that unfortunarly have to be worked around. I could reformat it by hand but this is to help out an employee that has to do it on a frequent basis. Plus, people have tried and failed to get this to work so I thought I and all you freindly and knowledgable people could give it a go. I will try your suggestion xld and see where I get. Thanks for the help.

[Bob Phillips]

It is a text file imported as text to columns. The problem is that there are soo many special characters in there that unfortunarly have to be worked around. I could reformat it by hand but this is to help out an employee that has to do it on a frequent basis. Plus, people have tried and failed to get this to work so I thought I and all you freindly and knowledgable people could give it a go. I will try your suggestion xld and see where I get. Thanks for the help.

Well if you spec it, bullet point instructions, a before and after picture, we could have a go as well.

[austenr]

Thanks xld...That works perfectly except for some cleanup I can do. Thanks and also thanks to geekgirlau...Mark solved. Now if I could only get that darn EXCEL file to write to an ACCESS DB...