VBA Dilemma

Herbiec09

Active Member
Joined
Aug 29, 2006
Messages
250
Hi All,

I have quite a tough one here....I have a bit of a unique problem, for which I was wondering if someone could help me with a VBA code. I download data through a query from a rather antiquated financial package, see below.
sample.xls
ABCDEFGHI
1TRANSACTIONSACCOUNTCENTRETYPEVALUEPERIODCOMMENTSSUPPLIER NAME.................SUPPLIER
2INVOICE123454095SI16INVOICE225.4200309W/C: 15/9/2003 (98 PLTS)MONKEYS INCMON001
3INVOICE123464095SI16INVOICE255.3200309W/C: 8/9/2003 (111 PLTS)MONKEYS INCMON001
4INVOICE123474095SI16INVOICE303.6200309SAT/STCK,W/C:25/8/2003MONKEYS INCMON001
5(132 PLTS)
6INVOICE123484095SI16INVOICE282.9200309SAT/STCK,W/C:1/9/2003 (123 PLTS)MONKEYS INCMON001
7INVOICE123495450SUS1INVOICE6.19200309RETURNS,PERIOD ENDING:15/8/2003MONKEYS INCMON001
8INVOICE123505430TRA1CREDIT NOTE-4.72200309SAT/STCK,INV:21684,ZONE 'B'MONKEYS INCMON001
9CHARGED S/B ZONE 'A'
10INVOICE123515430TRA1CREDIT NOTE-4.72200309SAT/STCK,INV:21570,ZONE 'B' CHARGED S/B ZONE 'A'MONKEYS INCMON001
11INVOICE123525430TRA1INVOICE9238.34200309PALLETS,PERIOD ENDING:12/9/2003MONKEYS INCMON001
12INVOICE123535430TRA1INVOICE103.85200309XTRA'S,PERIOD ENDING:12/9/2003MONKEYS INCMON001
13INVOICE123545430TRA1INVOICE70.75200309OTHER,PERIOD ENDING:12/9/2003MONKEYS INCMON001
14INVOICE123555430TRA1INVOICE391.13200309POST,PERIOD ENDING:12/9/2003MONKEYS INCMON001
Sheet1


My problem is with column G "comments", which as you will see from rows 5 & 9, whose contents belong at the end of the cell directly above it..

Could somebody help me with a code which will look at this data, where it finds a row with no data in columns a to e, it should then cut the contents of the relevant cell in column g and paste this at the end of the cell above and delete the now empty row, to produce the the spreadsheet as below:

[HTML removed by admin]
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.

texasalynn

Well-known Member
Joined
May 19, 2002
Messages
8,458
try this:
Code:
Sub cleanup()
Dim LR As Long
LR = Cells(65536, 1).End(xlUp).Row
        
        For i = 2 To LR
            If Cells(i, 5).Value = "" Then
            Cells(i - 1, 7).Value = Cells(i - 1, 7).Value & " " & Cells(i, 7).Value
            Cells(i, 7).EntireRow.Delete
                Else
            ' leave unchanged
            End If
        Next i

End Sub

Note: Be sure to save document before running this code, because you can't undo.
 

Greg Truby

MrExcel MVP
Joined
Jun 19, 2002
Messages
10,014
Heya Audry,

Hope yer just dandy. FWIW when deleting rows it's always a safer bet to roll backward up the list; i.e.
Code:
For i = LR to 2 Step -1

Regards,
 

Herbiec09

Active Member
Joined
Aug 29, 2006
Messages
250
Many thanks Texasalynn,

this seems to be working perfect, will this work for any number of rows that I have on the sheet ( a vba newbie), and if the problem was with row i and not g, what would change. Also these problem lines will appear randomly, will the code still work?

Many thanks
 

Herbiec09

Active Member
Joined
Aug 29, 2006
Messages
250

ADVERTISEMENT

Hi All,

On a closer look, it actuall does not work. What it does is it deletes the problem line, but before deleting the problem line, I need it to copy contents of column g to the cell above it (add to the endof that cell).

many thanks
 

Greg Truby

MrExcel MVP
Joined
Jun 19, 2002
Messages
10,014
Audry (and Herbie :biggrin:), here's a little different spin on it using something a little quicker than a straightforward "loop down the column" approach. Enjoy!
Code:
Sub CleanedUpCleanUp()
    Dim lngLastRow As Long, rngCell As Range, rngBlanks As Range
    
    lngLastRow = Range("A" & Rows.Count).End(xlUp).Row
    
    On Error Resume Next
    Set rngBlanks = Range("F1").Resize(lngLastRow).SpecialCells(xlCellTypeBlanks)
    If rngBlanks Is Nothing Then Exit Sub
    'rngBlanks.Interior.ColorIndex = 3
    For Each rngCell In rngBlanks.Cells
        With rngCell
            .Offset(-1, 1) = .Offset(-1, 1) & " " & .Offset(, 1)
        End With
    Next rngCell
    rngBlanks.EntireRow.Delete
    
End Sub

Regards,

Greg
 

Greg Truby

MrExcel MVP
Joined
Jun 19, 2002
Messages
10,014
Hi All,

On a closer look, it actuall does not work. What it does is it deletes the problem line, but before deleting the problem line, I need it to copy contents of column g to the cell above it (add to the endof that cell).

many thanks

I tested her code and it worked for me. :unsure:
 

Forum statistics

Threads
1,136,654
Messages
5,677,012
Members
419,668
Latest member
DharmaK

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top