Pete
06-30-2008, 11:59 AM
see snippet code below
Hi experts
Trying to add the following code to the button of the existing vba code......but doing something wrong cannot see the error i am making?
Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim Sheet As New Collection
Dim rng As Range
Dim rngRow As Long
Dim confirm As Boolean
Dim firstSupplierRow As Range
Dim lastSupplierRow As Range
Dim aSupplier As Range
Dim foundDemand As Boolean
'Dim suppliers As New Collection
'Dim demands() As String
'Dim ctrl As Control
'Dim loopControl As Long
'Dim var As Variant
'Dim supcol As Long
'Dim demcol As Long
'For each defined sheet
'If sheet is deal selection then
' If demand Is not present Then insert demand
'Else not sheet deal selection
'If supplier Is present Then
'if demand is not present
'append demand to this supplier
'end if demand present or not
'else supplier is not present
'Append supplier and demand
'end if supplier present or not
'End if deal selection or not
'next defined sheet
If Not ThisWorkbook.Worksheets("Deal Selection").Range("I:I").Find(TextBox1.Value) Is Nothing Then
MsgBox "CUSTOMER: " & TextBox1.Value & " Already Pre-Exists!", vbCritical, "Customer Duplication Error"
Exit Sub
End If
confirm = MsgBox("ARE YOU SURE YOU WANT TO ADD NEW CUSTOMER :> " & TextBox1.Value, vbYesNo, "ADDING CUSTOMER") = vbYes
If confirm Then
'Populate affected worksheets
Sheet.Add ThisWorkbook.Worksheets("Deal Selection")
Sheet.Add ThisWorkbook.Worksheets("Tables")
Sheet.Add ThisWorkbook.Worksheets("Alloc (sc.1)")
Sheet.Add ThisWorkbook.Worksheets("Alloc (sc.2)")
Sheet.Add ThisWorkbook.Worksheets("Alloc (sc.3)")
Sheet.Add ThisWorkbook.Worksheets("Modelling (Vol)")
Sheet.Add ThisWorkbook.Worksheets("Allocation (Vol)")
Sheet.Add ThisWorkbook.Worksheets("Cashflow Yearly")
Sheet.Add ThisWorkbook.Worksheets("Cashflow Q4")
Sheet.Add ThisWorkbook.Worksheets("Pricing Supply")
Sheet.Add ThisWorkbook.Worksheets("Pricing Demand")
Sheet.Add ThisWorkbook.Worksheets("CashFlow")
Sheet.Add ThisWorkbook.Worksheets("Revenue")
Sheet.Add ThisWorkbook.Worksheets("Cost of Purchase")
Sheet.Add ThisWorkbook.Worksheets("Shipping BOG")
Sheet.Add ThisWorkbook.Worksheets("Shipping UFC")
For Each ws In Sheet
If ws.Name = "Deal Selection" Then
Set rng = ws.Range("I:I").Find(TextBox1.Value)
If rng Is Nothing Then
' Debug.Print "add new item " & TextBox1.Value
ws.Range("I" & ws.Rows.Count).End(xlUp).Offset(1, 0).Value = TextBox1.Value
End If
ElseIf ws.Name = "Tables" Then
Set rng = ws.Range("L:L").Find(TextBox1.Value)
If rng Is Nothing Then
' Debug.Print "add new item " & TextBox1.Value
ws.Range("L" & ws.Rows.Count).End(xlUp).Offset(1, 0).Value = TextBox1.Value
ws.Range("L" & ws.Rows.Count).End(xlUp).HorizontalAlignment = xlCenter
ws.Range("L" & ws.Rows.Count).End(xlUp).Font.Color = 12632256
ws.Range("L" & ws.Rows.Count).End(xlUp).Borders(xlLeft).LineStyle = xlContinuous
ws.Range("L" & ws.Rows.Count).End(xlUp).Borders(xlRight).LineStyle = xlContinuous
ws.Range("L" & ws.Rows.Count).End(xlUp).Borders(xlBottom).LineStyle = xlContinuous
End If
ElseIf ws.Name = "CashFlow Q4" Or ws.Name = "CashFlow Yearly" Then
Set lastSupplierRow = ws.Range("B:B").Find("Supply").Offset(1, 0)
Do While lastSupplierRow.Row < ws.Range("C" & ws.Rows.Count).End(xlUp).Row
Set firstSupplierRow = lastSupplierRow
Do While lastSupplierRow.Value = firstSupplierRow.Value
Set lastSupplierRow = lastSupplierRow.Offset(1, 0)
Loop
foundDemand = False
For rngRow = firstSupplierRow.Row To lastSupplierRow.Offset(-1, 0).Row
'Debug.Print ws.Range("B" & rngRow).Value & " : " & ws.Range("B" & rngRow).Offset(0, 1).Value
If LCase(ws.Range("B" & rngRow).Offset(0, 1).Value) = LCase(TextBox1.Value) Then foundDemand = True
Next
If Not foundDemand Then
lastSupplierRow.Offset(-1, 0).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
' lastSupplierRow.EntireRow.Borders(xlEdgeTop).LineStyle = xlNone
lastSupplierRow.Offset(-2, 0) = firstSupplierRow.Value
lastSupplierRow.Offset(-2, 1) = TextBox1.Value
lastSupplierRow.Offset(-2, 2) = "MMUS$"
lastSupplierRow.Offset(-2, 3) = "CF_" & firstSupplierRow.Value & "_" & TextBox1.Value
sup = lastSupplierRow.Offset(-2, 0)
sup = Replace(sup, "+", "_plus")
sup = Replace(sup, ", ", "~")
sup = Replace(sup, " ", "_")
sup = Replace(sup, "~", ", ")
sup = Replace(sup, "-", "_")
sup = Replace(sup, "/", "_")
sup = Replace(sup, "(", "")
sup = Replace(sup, ")", "")
dem = lastSupplierRow.Offset(-2, 1)
dem = Replace(dem, "+", "_plus")
dem = Replace(dem, ", ", "~")
dem = Replace(dem, " ", "_")
dem = Replace(dem, "~", ", ")
dem = Replace(dem, "-", "_")
dem = Replace(dem, "/", "_")
dem = Replace(dem, "(", "")
dem = Replace(dem, ")", "")
lastSupplierRow.Offset(-2, 4).Resize(1, 128).FormulaArray = _
"=if(or(" & _
"iserror((Revenue_" & dem & "_" & sup & _
" - " & "Purchase_" & sup & "_" & dem & "))" & _
", A" & startrow + 1 & " = FALSE" & _
")" & _
",0" & _
"," & _
"(Revenue_" & dem & "_" & sup & _
" - " & "Purchase_" & sup & "_" & dem & "))"
End If
Set lastSupplierRow = lastSupplierRow.Offset(1, 0)
Loop
lastSupplierRow.Offset(0, 1).Borders(xlLeft).LineStyle = xlContinuous
lastSupplierRow.Offset(0, 2).Borders(xlLeft).LineStyle = xlContinuous
lastSupplierRow.Offset(0, 3).Borders(xlLeft).LineStyle = xlContinuous
lastSupplierRow.Offset(0, 4).Borders(xlLeft).LineStyle = xlContinuous
lastSupplierRow.Offset(0, 0).Borders(xlLeft).LineStyle = xlContinuous
lastSupplierRow.Offset(0, 0).Borders(xlLeft).Weight = xlMedium
lastSupplierRow.Offset(0, 131).Borders(xlRight).LineStyle = xlContinuous
lastSupplierRow.Offset(0, 131).Borders(xlRight).Weight = xlMedium
lastSupplierRow.Resize(1, 132).Borders(xlEdgeTop).LineStyle = xlContinuous
lastSupplierRow.Resize(1, 132).Borders(xlEdgeTop).Weight = xlMedium
'Next supplier
Else
Set lastSupplierRow = ws.Range("B:B").Find("Supply", LookAt:=xlWhole).Offset(1, 0)
Do While lastSupplierRow.Row < ws.Range("C" & ws.Rows.Count).End(xlUp).Row
Set firstSupplierRow = lastSupplierRow
Do While lastSupplierRow.Value = firstSupplierRow.Value
Set lastSupplierRow = lastSupplierRow.Offset(1, 0)
Loop
foundDemand = False
For rngRow = firstSupplierRow.Row To lastSupplierRow.Offset(-1, 0).Row
'Debug.Print ws.Range("B" & rngRow).Value & " : " & ws.Range("B" & rngRow).Offset(0, 1).Value
If LCase(ws.Range("B" & rngRow).Offset(0, 1).Value) = LCase(TextBox1.Value) Then foundDemand = True
Next
If Not foundDemand Then
lastSupplierRow.EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
lastSupplierRow.Offset(-1, 0).EntireRow.Borders(xlEdgeTop).LineStyle = xlNone
lastSupplierRow.Offset(-1, 0) = firstSupplierRow.Value
lastSupplierRow.Offset(-1, 1) = TextBox1.Value
lastSupplierRow.Offset(-1, 2) = "Tbtu"
sup = lastSupplierRow.Offset(-1, 0)
sup = Replace(sup, "+", "_plus")
sup = Replace(sup, ", ", "~")
sup = Replace(sup, " ", "_")
sup = Replace(sup, "~", ", ")
sup = Replace(sup, "-", "_")
sup = Replace(sup, "/", "_")
sup = Replace(sup, "(", "")
sup = Replace(sup, ")", "")
dem = lastSupplierRow.Offset(-1, 1)
dem = Replace(dem, "+", "_plus")
dem = Replace(dem, ", ", "~")
dem = Replace(dem, " ", "_")
dem = Replace(dem, "~", ", ")
dem = Replace(dem, "-", "_")
dem = Replace(dem, "/", "_")
dem = Replace(dem, "(", "")
dem = Replace(dem, ")", "")
lastSupplierRow.Offset(-1, 3) = "Vol_" & sup & "_" & dem
' lastSupplierRow.Offset(-2, 4).Resize(1, 128).FormulaArray = "=Vol_" & sup & "_" & dem
End If
Loop
lastSupplierRow.Offset(-1, 1).Borders(xlLeft).LineStyle = xlContinuous
lastSupplierRow.Offset(-1, 2).Borders(xlLeft).LineStyle = xlContinuous
lastSupplierRow.Offset(-1, 3).Borders(xlLeft).LineStyle = xlContinuous
lastSupplierRow.Offset(-1, 4).Borders(xlLeft).LineStyle = xlContinuous
lastSupplierRow.Offset(-1, 0).Borders(xlLeft).LineStyle = xlContinuous
lastSupplierRow.Offset(-1, 0).Borders(xlLeft).Weight = xlMedium
lastSupplierRow.Offset(-1, 131).Borders(xlRight).LineStyle = xlContinuous
lastSupplierRow.Offset(-1, 131).Borders(xlRight).Weight = xlMedium
lastSupplierRow.Resize(1, 132).Borders(xlEdgeTop).LineStyle = xlContinuous
lastSupplierRow.Resize(1, 132).Borders(xlEdgeTop).Weight = xlMedium
'Next supplier
End If
Next
reformat_Sheets
Else
MsgBox TextBox1.Value & " - CUSTOMER NOT ADDED", , "USER CANCEL"
End If
Unload Me
End Sub
Hi experts
Trying to add the following code to the button of the existing vba code......but doing something wrong cannot see the error i am making?
Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim Sheet As New Collection
Dim rng As Range
Dim rngRow As Long
Dim confirm As Boolean
Dim firstSupplierRow As Range
Dim lastSupplierRow As Range
Dim aSupplier As Range
Dim foundDemand As Boolean
'Dim suppliers As New Collection
'Dim demands() As String
'Dim ctrl As Control
'Dim loopControl As Long
'Dim var As Variant
'Dim supcol As Long
'Dim demcol As Long
'For each defined sheet
'If sheet is deal selection then
' If demand Is not present Then insert demand
'Else not sheet deal selection
'If supplier Is present Then
'if demand is not present
'append demand to this supplier
'end if demand present or not
'else supplier is not present
'Append supplier and demand
'end if supplier present or not
'End if deal selection or not
'next defined sheet
If Not ThisWorkbook.Worksheets("Deal Selection").Range("I:I").Find(TextBox1.Value) Is Nothing Then
MsgBox "CUSTOMER: " & TextBox1.Value & " Already Pre-Exists!", vbCritical, "Customer Duplication Error"
Exit Sub
End If
confirm = MsgBox("ARE YOU SURE YOU WANT TO ADD NEW CUSTOMER :> " & TextBox1.Value, vbYesNo, "ADDING CUSTOMER") = vbYes
If confirm Then
'Populate affected worksheets
Sheet.Add ThisWorkbook.Worksheets("Deal Selection")
Sheet.Add ThisWorkbook.Worksheets("Tables")
Sheet.Add ThisWorkbook.Worksheets("Alloc (sc.1)")
Sheet.Add ThisWorkbook.Worksheets("Alloc (sc.2)")
Sheet.Add ThisWorkbook.Worksheets("Alloc (sc.3)")
Sheet.Add ThisWorkbook.Worksheets("Modelling (Vol)")
Sheet.Add ThisWorkbook.Worksheets("Allocation (Vol)")
Sheet.Add ThisWorkbook.Worksheets("Cashflow Yearly")
Sheet.Add ThisWorkbook.Worksheets("Cashflow Q4")
Sheet.Add ThisWorkbook.Worksheets("Pricing Supply")
Sheet.Add ThisWorkbook.Worksheets("Pricing Demand")
Sheet.Add ThisWorkbook.Worksheets("CashFlow")
Sheet.Add ThisWorkbook.Worksheets("Revenue")
Sheet.Add ThisWorkbook.Worksheets("Cost of Purchase")
Sheet.Add ThisWorkbook.Worksheets("Shipping BOG")
Sheet.Add ThisWorkbook.Worksheets("Shipping UFC")
For Each ws In Sheet
If ws.Name = "Deal Selection" Then
Set rng = ws.Range("I:I").Find(TextBox1.Value)
If rng Is Nothing Then
' Debug.Print "add new item " & TextBox1.Value
ws.Range("I" & ws.Rows.Count).End(xlUp).Offset(1, 0).Value = TextBox1.Value
End If
ElseIf ws.Name = "Tables" Then
Set rng = ws.Range("L:L").Find(TextBox1.Value)
If rng Is Nothing Then
' Debug.Print "add new item " & TextBox1.Value
ws.Range("L" & ws.Rows.Count).End(xlUp).Offset(1, 0).Value = TextBox1.Value
ws.Range("L" & ws.Rows.Count).End(xlUp).HorizontalAlignment = xlCenter
ws.Range("L" & ws.Rows.Count).End(xlUp).Font.Color = 12632256
ws.Range("L" & ws.Rows.Count).End(xlUp).Borders(xlLeft).LineStyle = xlContinuous
ws.Range("L" & ws.Rows.Count).End(xlUp).Borders(xlRight).LineStyle = xlContinuous
ws.Range("L" & ws.Rows.Count).End(xlUp).Borders(xlBottom).LineStyle = xlContinuous
End If
ElseIf ws.Name = "CashFlow Q4" Or ws.Name = "CashFlow Yearly" Then
Set lastSupplierRow = ws.Range("B:B").Find("Supply").Offset(1, 0)
Do While lastSupplierRow.Row < ws.Range("C" & ws.Rows.Count).End(xlUp).Row
Set firstSupplierRow = lastSupplierRow
Do While lastSupplierRow.Value = firstSupplierRow.Value
Set lastSupplierRow = lastSupplierRow.Offset(1, 0)
Loop
foundDemand = False
For rngRow = firstSupplierRow.Row To lastSupplierRow.Offset(-1, 0).Row
'Debug.Print ws.Range("B" & rngRow).Value & " : " & ws.Range("B" & rngRow).Offset(0, 1).Value
If LCase(ws.Range("B" & rngRow).Offset(0, 1).Value) = LCase(TextBox1.Value) Then foundDemand = True
Next
If Not foundDemand Then
lastSupplierRow.Offset(-1, 0).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
' lastSupplierRow.EntireRow.Borders(xlEdgeTop).LineStyle = xlNone
lastSupplierRow.Offset(-2, 0) = firstSupplierRow.Value
lastSupplierRow.Offset(-2, 1) = TextBox1.Value
lastSupplierRow.Offset(-2, 2) = "MMUS$"
lastSupplierRow.Offset(-2, 3) = "CF_" & firstSupplierRow.Value & "_" & TextBox1.Value
sup = lastSupplierRow.Offset(-2, 0)
sup = Replace(sup, "+", "_plus")
sup = Replace(sup, ", ", "~")
sup = Replace(sup, " ", "_")
sup = Replace(sup, "~", ", ")
sup = Replace(sup, "-", "_")
sup = Replace(sup, "/", "_")
sup = Replace(sup, "(", "")
sup = Replace(sup, ")", "")
dem = lastSupplierRow.Offset(-2, 1)
dem = Replace(dem, "+", "_plus")
dem = Replace(dem, ", ", "~")
dem = Replace(dem, " ", "_")
dem = Replace(dem, "~", ", ")
dem = Replace(dem, "-", "_")
dem = Replace(dem, "/", "_")
dem = Replace(dem, "(", "")
dem = Replace(dem, ")", "")
lastSupplierRow.Offset(-2, 4).Resize(1, 128).FormulaArray = _
"=if(or(" & _
"iserror((Revenue_" & dem & "_" & sup & _
" - " & "Purchase_" & sup & "_" & dem & "))" & _
", A" & startrow + 1 & " = FALSE" & _
")" & _
",0" & _
"," & _
"(Revenue_" & dem & "_" & sup & _
" - " & "Purchase_" & sup & "_" & dem & "))"
End If
Set lastSupplierRow = lastSupplierRow.Offset(1, 0)
Loop
lastSupplierRow.Offset(0, 1).Borders(xlLeft).LineStyle = xlContinuous
lastSupplierRow.Offset(0, 2).Borders(xlLeft).LineStyle = xlContinuous
lastSupplierRow.Offset(0, 3).Borders(xlLeft).LineStyle = xlContinuous
lastSupplierRow.Offset(0, 4).Borders(xlLeft).LineStyle = xlContinuous
lastSupplierRow.Offset(0, 0).Borders(xlLeft).LineStyle = xlContinuous
lastSupplierRow.Offset(0, 0).Borders(xlLeft).Weight = xlMedium
lastSupplierRow.Offset(0, 131).Borders(xlRight).LineStyle = xlContinuous
lastSupplierRow.Offset(0, 131).Borders(xlRight).Weight = xlMedium
lastSupplierRow.Resize(1, 132).Borders(xlEdgeTop).LineStyle = xlContinuous
lastSupplierRow.Resize(1, 132).Borders(xlEdgeTop).Weight = xlMedium
'Next supplier
Else
Set lastSupplierRow = ws.Range("B:B").Find("Supply", LookAt:=xlWhole).Offset(1, 0)
Do While lastSupplierRow.Row < ws.Range("C" & ws.Rows.Count).End(xlUp).Row
Set firstSupplierRow = lastSupplierRow
Do While lastSupplierRow.Value = firstSupplierRow.Value
Set lastSupplierRow = lastSupplierRow.Offset(1, 0)
Loop
foundDemand = False
For rngRow = firstSupplierRow.Row To lastSupplierRow.Offset(-1, 0).Row
'Debug.Print ws.Range("B" & rngRow).Value & " : " & ws.Range("B" & rngRow).Offset(0, 1).Value
If LCase(ws.Range("B" & rngRow).Offset(0, 1).Value) = LCase(TextBox1.Value) Then foundDemand = True
Next
If Not foundDemand Then
lastSupplierRow.EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
lastSupplierRow.Offset(-1, 0).EntireRow.Borders(xlEdgeTop).LineStyle = xlNone
lastSupplierRow.Offset(-1, 0) = firstSupplierRow.Value
lastSupplierRow.Offset(-1, 1) = TextBox1.Value
lastSupplierRow.Offset(-1, 2) = "Tbtu"
sup = lastSupplierRow.Offset(-1, 0)
sup = Replace(sup, "+", "_plus")
sup = Replace(sup, ", ", "~")
sup = Replace(sup, " ", "_")
sup = Replace(sup, "~", ", ")
sup = Replace(sup, "-", "_")
sup = Replace(sup, "/", "_")
sup = Replace(sup, "(", "")
sup = Replace(sup, ")", "")
dem = lastSupplierRow.Offset(-1, 1)
dem = Replace(dem, "+", "_plus")
dem = Replace(dem, ", ", "~")
dem = Replace(dem, " ", "_")
dem = Replace(dem, "~", ", ")
dem = Replace(dem, "-", "_")
dem = Replace(dem, "/", "_")
dem = Replace(dem, "(", "")
dem = Replace(dem, ")", "")
lastSupplierRow.Offset(-1, 3) = "Vol_" & sup & "_" & dem
' lastSupplierRow.Offset(-2, 4).Resize(1, 128).FormulaArray = "=Vol_" & sup & "_" & dem
End If
Loop
lastSupplierRow.Offset(-1, 1).Borders(xlLeft).LineStyle = xlContinuous
lastSupplierRow.Offset(-1, 2).Borders(xlLeft).LineStyle = xlContinuous
lastSupplierRow.Offset(-1, 3).Borders(xlLeft).LineStyle = xlContinuous
lastSupplierRow.Offset(-1, 4).Borders(xlLeft).LineStyle = xlContinuous
lastSupplierRow.Offset(-1, 0).Borders(xlLeft).LineStyle = xlContinuous
lastSupplierRow.Offset(-1, 0).Borders(xlLeft).Weight = xlMedium
lastSupplierRow.Offset(-1, 131).Borders(xlRight).LineStyle = xlContinuous
lastSupplierRow.Offset(-1, 131).Borders(xlRight).Weight = xlMedium
lastSupplierRow.Resize(1, 132).Borders(xlEdgeTop).LineStyle = xlContinuous
lastSupplierRow.Resize(1, 132).Borders(xlEdgeTop).Weight = xlMedium
'Next supplier
End If
Next
reformat_Sheets
Else
MsgBox TextBox1.Value & " - CUSTOMER NOT ADDED", , "USER CANCEL"
End If
Unload Me
End Sub