Insert cells based on duplicate entries

[Versace77]

Hey everyone, looking for some help and not sure if it's possible. I tried
checking other topics but couldn't find anything relative.

i have a spreadsheet that people paste data to on the left side, (columns
a,b and c). The fields are Date, Voucher number (all unique numbers) and
dollar amount. A query from a retrieval system populates this same data on
the right hand side with. However, on the right hand-side there may be two
'like' voucher numbers where the monetary total adds up to the one total on
the left side. When this occurs we need to insert cells and shift down on
the left hand side to keep all the voucher numbers in sequence by row.

Looking for a macro to do this for me as there can be more than 50 separate
insert cell, shift cell down actions taking place daily and it takes quite a
bit of time.

Here's a drawing of what i'm talking about.

Before:

02/17/09 VVDA123 $4,400.00 02/17/09 VVDA123
$4,000.00
02/17/09 VVDA155 $2,000.00 02/17/09 VVDA123
$400.00
02/17/09 VVDA200 $950.00 02/17/09 VVDA155
$2,000.00

02/17/09 VVDA200 $950.00

I want it to look like this:

02/17/09 VVDA123 $4,400.00 02/17/09 VVDA123
$4,000.00

02/17/09 VVDA123 $400.00
02/17/09 VVDA155 $2,000.00 02/17/09 VVDA155
$2,000.00
02/17/09 VVDA200 $950.00 02/17/09 VVDA200
$950.00

Hope this makes sense to someone out there. The spreadsheet is rather large
as daily data is appended. If the macro would be too slow running through
the entire sheet would it be possible to have the macro work just on selected
cells?

Thanks in advance for any help here.

 

[Versace77]

after reading my post it looks like the dollar amount from the right handside
is now under the date column on the left hand-side. it shouldn't be. it
should be on the right.

 

[Joel]

See if this macro works.. It assumes the left side is columns A - c and theh
Right side Columns D - F

Sub MakeNewRows()

RowCount = 1
Do While Range("A" & RowCount) <> ""
If Range("B" & RowCount) <> Range("E" & RowCount) Then
Rows(RowCount).Insert
Range("D" & (RowCount + 1) & ":F" & (RowCount + 1)).Cut _
Destination:=Range("A" & RowCount).Paste
RowCount = RowCount + 1
End If
If Range("B" & RowCount) = Range("B" & (RowCount + 1)) And _
Range("C" & RowCount) = Range("C" & (RowCount + 1)) Then


Range("A" & (RowCount + 1) & ":C" & (RowCount + 1)).Cut _
Destination:=Range("D" & RowCount).Paste
Rows(RowCount + 1).Delete
End If
RowCount = RowCount + 1
Loop


End Sub

 

[Versace77]

Joel,

Thanks for responding.

I made a test example using the columns specified in your macro. It would
create a new row above all the information, and that was it.

Also, upon further reviewing i have found the following: The date column is
not present on the right hand-side. Also, the beginning of the voucher
numbers are different while the number itself is the same. For example. on
the left we would see VVDA123, on the right it could be something like
DACG123, the numbers 123 are the same and is used to match the vouchers
together.

Givin this information, can i what i requested be possible? below is an
updated diagram of what i'm looking for:

Notice how in the 'after' example, a few cells have been inserted on the
left-hand side under VVDA123, the the cells were shifted downward. Now the
vouchers below, e.g., 155 are on the same row.

Thank you!

 

[Joel]

Try this

Sub MakeNewRows()

RowCount = 1
Do While Range("A" & RowCount) <> ""
LeftNum = Range("B" & RowCount)
Do While Not IsNumeric(Left(LeftNum, 1))
LeftNum = Mid(LeftNum, 2)
Loop
LeftNum = Val(LeftNum)

RightNum = Range("D" & RowCount)
Do While Not IsNumeric(Left(RightNum, 1))
RightNum = Mid(RightNum, 2)
Loop
RightNum = Val(RightNum)

If LeftNum <> RightNum Then
Rows(RowCount).Insert
Range("D" & RowCount & ":E" & RowCount).Delete Shift:=xlUp
End If

RowCount = RowCount + 1
Loop


End Sub

 

[Versace77]

Joel,

Back from TDY and saw your response. thanks again for taking the time to
help. I have tried this code and am still having issues. I have changed a
few areas to match the colums on my worksheet but am making errors somewhere.
I edited the code to this:

Sub Makenewrows()

RowCount = 1
Do While Range("A" & RowCount) <> ""
LeftNum = Range("B" & RowCount)
Do While Not IsNumeric(Left(LeftNum, 1))
LeftNum = Mid(LeftNum, 2)
Loop
LeftNum = Val(LeftNum)

RightNum = Range("G" & RowCount)
Do While Not IsNumeric(Left(RightNum, 1))
RightNum = Mid(RightNum, 2)
Loop
RightNum = Val(RightNum)

If LeftNum <> RightNum Then
Rows(RowCount).Insert
Range("D" & RowCount & ":J" & RowCount).Delete Shift:=xlUp
End If

RowCount = RowCount + 1
Loop


End Sub

Here is a small sample of my data with columns included (G/H sometimes has
data):
A B C E
F G H
2/5/2009 GOB-0767 $77.29 6GB0767 8.22
2/5/2009 GOB-0768 $47.25 6GB0767 69.07
2/5/2009 GOB-0769 $79.15 6GB0768 2.53
2/5/2009 GOB-0770 $359.01 6GB0768 44.72

I'd like it to look like this:

A B C E
F G H
2/5/2009 GOB-0767 $77.29 6GB0767 8.22
6GB0767 69.07
2/5/2009 GOB-0768 $47.25 6GB0768 2.53
6GB0768 44.72
2/5/2009 GOB-0769 $79.15
2/5/2009 GOB-0770 $359.01

Here's what happens when I run the macro:

A B C E
F G H
6GB0767 8.22
6GB0767 69.07
6GB0768 2.53
6GB0768 44.72
2/5/2009 GOB-0767 $77.29
2/5/2009 GOB-0768 $47.25
2/5/2009 GOB-0769 $79.15
2/5/2009 GOB-0770 $359.01

Hopefully the formatting of the diagrams stays the same after it posts to
the forum. again, thanks and would appreciate further support on this. If
you need any more information to help, just let me know.

 

[Joel]

You had very unusal data. It is like some of the assingments I got from
teachers who would purposely make the data hard to wrok with so you would
learn to perform error checking. I had to change the code to search the ID's
from right to left because some of the ID's started with a Digit. then I had
problems using the ISNUMERIC() function because the dash (-) looks like a
negative sign and was being treated as a digit. I then eliminated the
ISNUMERIC() check and replace it with a check looking for characters between
"0" and "9"

Sub Makenewrows()

Dim LeftNum As String
Dim RightNum As String


RowCount = 1
Do While Range("A" & RowCount) <> ""
LeftNum = Range("B" & RowCount)

If LeftNum <> "" Then
CharCount = 0
Length = Len(LeftNum)
Do
If CharCount > Length Then Exit Do
CharCount = CharCount + 1
Char = Right(LeftNum, CharCount)
Loop While Asc(Char) >= Asc("0") And _
Asc(Char) <= Asc("9")

If CharCount >= 1 Then
LeftNum = Right(LeftNum, CharCount - 1)
Else
LeftNum = 0
End If
End If


RightNum = Range("G" & RowCount)

If RightNum <> "" Then
CharCount = 0
Length = Len(RightNum)
Do
If CharCount > Length Then Exit Do
CharCount = CharCount + 1
Char = Right(RightNum, CharCount)
Loop While Asc(Char) >= Asc("0") And _
Asc(Char) <= Asc("9")

If CharCount >= 1 Then
RightNum = Right(RightNum, CharCount - 1)
Else
RightNum = 0
End If
End If

If RightNum <> "" Then
If LeftNum <> RightNum Then
Rows(RowCount).Insert
Range("D" & RowCount & ":J" & RowCount).Delete Shift:=xlUp
End If
End If

RowCount = RowCount + 1
Loop

End Sub

 

[Versace77]

Joel,

I agree, the data isn't the easiest to work with, the error check is taking
information from 2 separate systems where ID numbers are different and
subsequently, the number of transactions per ID can vary as well.

Unfortunately running your latest creation did not visibly change any data.
The macro ran from start to finish. Would you know what could cause this to
happen? Also, if you feel at any point that we've beat this horse enough,
just let me know and I'll be ok with it and maybe pursue it again down the
road. Not having this wouldn't create a work stoppage by any means but it
would be beneficial in saving a good portion of time.

Joel, thanks again and I look forward to hearing from you.

 

[Joel]

email me the file. It is probably something very simple to fix.

joel dot warburg at itt dot com