VBA Excel Help

[budman9]

Hi Folks,

Hopefully someone here might be able to help me.

Currently i have a spreadsheet with a number of columns. For example the columns include 'Description', 'Product', 'Quantity' and 'Price'. The quantity column, for instance, can sometimes have a value of over one (two, three, eight or even ten or twenty). And herein lies the problem!

Ideally I would like each quantity to have its unique row in the spreadsheet with the quantity being "1" right the way through the sheet.

I wrote a short script to handle this, however, my big problem is dividing up the 'Price' column, as it represents Total Cost for a quantity. Currently my script copies and pastes the entire row depending on the quantity. For instance if the quantity were 3, the row would be copied twice and display 3 seperate rows. However the 'Price' would still remain as a total cost for each unit.

Would anyone know how I would split the Total Cost cell, in accordance with the quantity? For example if the quantity was 5 and the total cost was 500. How would i split the single row into 5 separate rows while also having a Price of 100 for each?

Does this make sense to anyone? I really hope I explained it correctly as I've been immersed in this for a few days now and its driving me insane!

[vba]Function Match_Data_Master()
Worksheets("Sheet3").Select
Sheets("Sheet3").Range("d1").Select
I = 1
ref = ActiveCell.Value
Dim REFBACK As String
Dim PRODUCT As Integer
While ActiveCell <> "" Or IsNull(ActiveCell)
If ActiveCell.Value = 0 Then
ActiveCell.Offset(0, 5).Value = 0
Else
ActiveCell.Offset(0, 5).Value = 1
PRODUCT = PRODUCT + 1
End If
ref = ActiveCell.Value
REFBACK = ActiveCell.Value
If ref > 1 Then
Dim j As Variant
j = ref
While j <> 1
Rows(ActiveCell.Row).Select
Selection.Copy
Selection.Insert Shift:=xlDown
ActiveCell.Offset(1, 0).Select
j = j - 1
PRODUCT = PRODUCT + 1
Wend
ActiveCell.Offset(0, 3).Select
End If
ActiveCell.Offset(1, 0).Select
I = I + 1
Wend
'Range("J1").Select
'Application.CutCopyMode = False
'ActiveCell.FormulaR1C1 = "=SUM(J[-1])"
'Range("J1").Select
Dim Lr As Long
Lr = Cells(Rows.Count, "i").End(xlUp).Row + 1
Cells(Lr, "i").Formula = "=SUM(I1:J" & Lr - 1 & ")"
'Columns("C:C").Select
'Selection.Delete Shift:=xlToLeft
MsgBox "Number of Products: " & PRODUCT
End Function
End Function
[/vba]

Thanks for anyone who read the post, its pretty long but if anyone has any tips or pointers about where to go i'd be very very grateful!

Cheers

[davmec93]

Hi Folks,

Hopefully someone here might be able to help me.

Currently i have a spreadsheet with a number of columns. For example the columns include 'Description', 'Product', 'Quantity' and 'Price'. The quantity column, for instance, can sometimes have a value of over one (two, three, eight or even ten or twenty). And herein lies the problem!

Ideally I would like each quantity to have its unique row in the spreadsheet with the quantity being "1" right the way through the sheet.

I wrote a short script to handle this, however, my big problem is dividing up the 'Price' column, as it represents Total Cost for a quantity. Currently my script copies and pastes the entire row depending on the quantity. For instance if the quantity were 3, the row would be copied twice and display 3 seperate rows. However the 'Price' would still remain as a total cost for each unit.

Would anyone know how I would split the Total Cost cell, in accordance with the quantity? For example if the quantity was 5 and the total cost was 500. How would i split the single row into 5 separate rows while also having a Price of 100 for each?

Does this make sense to anyone? I really hope I explained it correctly as I've been immersed in this for a few days now and its driving me insane!

[vba]Function Match_Data_Master()
Worksheets("Sheet3").Select
Sheets("Sheet3").Range("d1").Select
I = 1
ref = ActiveCell.Value
Dim REFBACK As String
Dim PRODUCT As Integer
While ActiveCell <> "" Or IsNull(ActiveCell)
If ActiveCell.Value = 0 Then
ActiveCell.Offset(0, 5).Value = 0
Else
ActiveCell.Offset(0, 5).Value = 1
PRODUCT = PRODUCT + 1
End If
ref = ActiveCell.Value
REFBACK = ActiveCell.Value
If ref > 1 Then
Dim j As Variant
j = ref
While j <> 1
Rows(ActiveCell.Row).Select
Selection.Copy
Selection.Insert Shift:=xlDown
ActiveCell.Offset(1, 0).Select
j = j - 1
PRODUCT = PRODUCT + 1
Wend
ActiveCell.Offset(0, 3).Select
End If
ActiveCell.Offset(1, 0).Select
I = I + 1
Wend
'Range("J1").Select
'Application.CutCopyMode = False
'ActiveCell.FormulaR1C1 = "=SUM(J[-1])"
'Range("J1").Select
Dim Lr As Long
Lr = Cells(Rows.Count, "i").End(xlUp).Row + 1
Cells(Lr, "i").Formula = "=SUM(I1:J" & Lr - 1 & ")"
'Columns("C:C").Select
'Selection.Delete Shift:=xlToLeft
MsgBox "Number of Products: " & PRODUCT
End Function
End Function
[/vba]

Thanks for anyone who read the post, its pretty long but if anyone has any tips or pointers about where to go i'd be very very grateful!

Cheers

Is there a way you can post a small example of your spreadsheet?

[Bob Phillips]

[vba]

Public Sub ProcessData()
Dim lastrow As Long
Dim numrows As Long
Dim oldValue As Double
Dim i As Long
Dim cell As Range

Application.ScreenUpdating = False

With Worksheets("Sheet3")

lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = lastrow To 2 Step -1

If .Cells(i, "C").Value2 > 1 Then

numrows = .Cells(i, "C").Value2
.Rows(i + 1).Resize(numrows - 1).Insert
.Rows(i).Copy .Cells(i + 1, "A").Resize(numrows - 1)
.Cells(i, "C").Resize(numrows).Value = 1
oldValue = .Cells(i, "D").Value2
.Cells(i, "D").Resize(numrows).Value = Application.Round(oldValue / numrows, 2)
If Application.Sum(.Cells(i, "D").Resize(numrows)) <> .Cells(i, "D").Value2 Then

.Cells(i, "D").Value = .Cells(i, "D").Value _
+ oldValue _
- Application.Sum(.Cells(i, "D").Resize(numrows))
End If
End If
Next i
End With

Application.ScreenUpdating = True
End Sub
[/vba]