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
Reply With Quote
