S
sycsummit
I have a macro that was written for me that was working for a while and when
I made some changes to my worksheet the last time it stopped working. I've
set up a form that is used to order clothing for my company, and when it gets
billed I have employed this macro to break down the order total by
individual, so payroll knows how much to deduct from which employee's expense
allowances. In short, the script is supposed to generate a list of names
that appears in a separate worksheet, with each name showing up only once,
alongside the corresponding total for all items purchased by that individual
(employees can purchase more than one item of clothing at a time).
This is the script:
Sub MoveUniqueNames()
Dim X As Long
Dim Y As Long
Dim Z As Long
Dim LastCell As Long
Dim Total As Double
Dim UniqueNames As String
Const SourceColumn As String = "K"
Const SourceStartRow As Long = 4
Const DestinationColumn As String = "A"
Const DestinationStartRow As Long = 5
Const SourceMoneyColumn As String = "J"
Const DestinationMoneyColumn As String = "B"
Const SourceSheet As String = "NEW"
Const UniqueSheet As String = "Billing"
UniqueNames = "*"
Z = DestinationStartRow
With Worksheets(SourceSheet)
LastCell = .Cells(.Rows.Count, SourceColumn).End(xlUp).Row
For X = SourceStartRow To LastCell
If .Cells(X, SourceColumn) <> "" Then
If InStr(UniqueNames, "*" & _
.Cells(X, SourceColumn).Value & "*") = 0 Then
UniqueNames = UniqueNames & .Cells(X, SourceColumn).Value & "*"
Worksheets(UniqueSheet).Cells(Z, DestinationColumn).Value = _
.Cells(X, SourceColumn).Value
Z = Z + 1
End If
End If
Next
For X = DestinationStartRow To Z - 1
Total = 0
For Y = SourceStartRow To LastCell
If .Cells(Y, SourceColumn).Value = Worksheets(UniqueSheet). _
Cells(X, DestinationColumn).Value Then
Total = Total + .Cells(Y, SourceMoneyColumn).Value
End If
Next
Worksheets(UniqueSheet).Cells(X, DestinationMoneyColumn).Value = Total
Next
End With
End Sub
***The bug is on the line "Total = Total + .Cells(Y, SourceMoneyColumn).Value"
I don't know much about programming and can't figure out why it won't go
through. Any thoughts? If I need to include more information, I'd be happy
to.
I made some changes to my worksheet the last time it stopped working. I've
set up a form that is used to order clothing for my company, and when it gets
billed I have employed this macro to break down the order total by
individual, so payroll knows how much to deduct from which employee's expense
allowances. In short, the script is supposed to generate a list of names
that appears in a separate worksheet, with each name showing up only once,
alongside the corresponding total for all items purchased by that individual
(employees can purchase more than one item of clothing at a time).
This is the script:
Sub MoveUniqueNames()
Dim X As Long
Dim Y As Long
Dim Z As Long
Dim LastCell As Long
Dim Total As Double
Dim UniqueNames As String
Const SourceColumn As String = "K"
Const SourceStartRow As Long = 4
Const DestinationColumn As String = "A"
Const DestinationStartRow As Long = 5
Const SourceMoneyColumn As String = "J"
Const DestinationMoneyColumn As String = "B"
Const SourceSheet As String = "NEW"
Const UniqueSheet As String = "Billing"
UniqueNames = "*"
Z = DestinationStartRow
With Worksheets(SourceSheet)
LastCell = .Cells(.Rows.Count, SourceColumn).End(xlUp).Row
For X = SourceStartRow To LastCell
If .Cells(X, SourceColumn) <> "" Then
If InStr(UniqueNames, "*" & _
.Cells(X, SourceColumn).Value & "*") = 0 Then
UniqueNames = UniqueNames & .Cells(X, SourceColumn).Value & "*"
Worksheets(UniqueSheet).Cells(Z, DestinationColumn).Value = _
.Cells(X, SourceColumn).Value
Z = Z + 1
End If
End If
Next
For X = DestinationStartRow To Z - 1
Total = 0
For Y = SourceStartRow To LastCell
If .Cells(Y, SourceColumn).Value = Worksheets(UniqueSheet). _
Cells(X, DestinationColumn).Value Then
Total = Total + .Cells(Y, SourceMoneyColumn).Value
End If
Next
Worksheets(UniqueSheet).Cells(X, DestinationMoneyColumn).Value = Total
Next
End With
End Sub
***The bug is on the line "Total = Total + .Cells(Y, SourceMoneyColumn).Value"
I don't know much about programming and can't figure out why it won't go
through. Any thoughts? If I need to include more information, I'd be happy
to.