Formula Error

[goss]

Hi all,

I am try to unstack data I receive in an email as this

Inv Nmbr
Inv Date
Inv Amount

To this:

Inv Nmbr | Inv Date | Inv Amnt

My code below works for several rows of data and then returns an error on row 13
The only difference I see in the data:

Rec 1: 64.70
Rec 2: 0.00
Rec 3: -15.28

So it appears the negative amount may be causing the error, but I cannot figure out why?

Full code below

thanks
w

Option Explicit

Sub GetTrxAmount()
    Dim wbBook As Workbook
    Dim wsData As Worksheet
    Dim strFormula As String
    Dim lngRows As Long
    Dim C As Range
    
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .Calculation = xlCalculationManual
    End With
    
    Set wbBook = ThisWorkbook
    Set wsData = wbBook.Worksheets("Data")

    lngRows = wsData.Range("A65536").End(xlUp).Row
    strFormula = "=IF(ISERROR(FIND(""Amount"",OFFSET(A1,2,3))),0,VALUE(MID(OFFSET(A1,2,3),16,LEN(OFFSET(A1,2,3))-15)))"
     
    With wsData
        .Range("C1").EntireColumn.Insert
        .Range("C1:C" & lngRows).Formula = strFormula
'        .Range("C1:C" & lngRows).NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* " - "??_);_(@_)"
        
        For Each C In .Range("C1:C" & lngRows)
            C.Value = C.Value
        Next C
    End With
    
    
        
    'Set Column Width
        wsData.Columns("C").ColumnWidth = 12
    
    '//Cleanup
        Set wbBook = Nothing
        Set wsData = Nothing
        Set C = Nothing

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
        .Calculation = xlCalculationAutomatic
    End With
     
End Sub

 

[BobUmlas]

I may be wrong here, but it looks like you have a space after the minus sign -- could that be your problem?

 

[goss]

Thanks Bob,

That is either my typo or just the way it displays in the editor.
There is no space in the actual data
The amount returned on row 13 is -15.28 (no space)
I can manually format for accounting number format
I can manually copy/paste as value only

But when I try to include these two operations in the vba code I receive an error on row 13

Error:

Run-time error '1004':
Application-defined or object-defined error

 

[Rick Rothstein]

If I understand your request correctly (data in Column A, unstack every three rows as a group, no break between any of the data), I believe this code will do what you want...

Sub Unstack()
  Dim X As Long, LastRow As Long
  Const StartRow As Long = 1
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  For X = StartRow To LastRow Step 3
    Cells(X, "B").Resize(, 2) = WorksheetFunction.Transpose(Cells(X + 1, "A").Resize(2))
  Next
  Cells(StartRow, "B").Resize(LastRow).SpecialCells(xlBlanks).EntireRow.Delete
End Sub

 

[goss]

Thanks Rick,

That is cool and way shorter than my current code
Problem is I need to return substrings from longer strings in each record set

Ex:

Input:
Original Invoice number: 2011091909GOSS54
Invoice Date: 19-Sept-2011
Invoice Amount: 100.23

Desired output:
2011091909GOSS54 | 19-Sept-2011 | 100.23

I have the code split into a couple of modules
First 2 work great and return the invoice number and invoice date as expected
The problem comes when I try to run the 3rd procedure to get the Invoice Amount