Challenging Macro to reverse the function of an existing macro

[keilah]

See attched workbook...............

Note this question has not been posted elsewhere...........

Not sure how to do this....Need a macro that will do the opposite of origianl macro see worksheet "Deal Selection" clearly marke with arrows.....

Current the user can select from the blue ADD macro button via a userform a supply customer (radio button) and then a demand customer via the chk box same userfrom then > click ok

second userform you have the option of either selecting opt FOB or DES (at present you can only select the supply worksheet) demand worksheet inactivite..........

hence the macro creates aworksheet and posts it to the work book.......

KNOW i need to do the opposite of this..........via the new macro buttons clearly marked on worksheet "Deal Selection"..........

so this time i want the demand customers with the radio button and the supply customer on the chk box........

[keilah]

here is my verison of macro add demand - not sure if i have made all the right changes correctly:



[VBA]
Option Explicit
Public formStatus As Integer
Public dmd As String
Public sup As String
Public alloc As Range
Public price As Range
Public freight As Range
Public purchase As Range
Public revenue As Range

Private Sub CanxButton_Click()
'Dim ctrl As Control
'
' If formStatus = 1 Then
' For Each ctrl In frmAddSupply.Controls
' If ctrl.Name Like "Demand*" Or ctrl.Name Like "Supply*" Then
' ctrl.Value = False
' End If
' Next
' ElseIf formStatus = 2 Then
' End If
'
Unload Me
End Sub
Private Sub OKButton_Click()
Dim ctrl As Control
Dim reformStatus As Integer
Dim strings() As String
Dim arrLoop As Integer

If formStatus = 1 Then
reform reformStatus
If reformStatus = 1 Then
ElseIf reformStatus = 2 Then
MsgBox "Maximum 4 fields from Demand Fields supported.", vbInformation
sup = ""
dmd = ""
Else
MsgBox "Please select at least one of each Supply & Demand Fields.", vbInformation
sup = ""
dmd = ""
End If
ElseIf formStatus = 2 Then
checkRows (UBound(Split(dmd, ", ")) + 1)
' If frmAddSupply.Controls("cboSheets").Text Like "D_*" Then
If frmAddSupply.Controls("cboSheets").Text = "Demand" Then
' selected worksheet is supply (dmd) but dunno what to do with it currently
Else
' selected worksheet is demand (sup) but dunno what to do with it currently
End If
strings = Split(sup, ", ")
For arrLoop = 0 To UBound(strings)
With ActiveWorkbook.Worksheets(dmd).Range(alloc.Address)
.Offset(2 + arrLoop, 0) = strings(arrLoop)
.Offset(2 + arrLoop, 2) = "Alloc_" & dmd & "_" & strings(arrLoop)
.Offset(2 + arrLoop, 3).Resize(1, 48).FormulaArray = "=" & dmd & "_" & strings(arrLoop)
End With
ActiveWorkbook.Names.Add Name:="Alloc_" & dmd & "_" & strings(arrLoop), RefersToR1C1:= _
ActiveWorkbook.Worksheets(dmd).Range(alloc.Address).Offset(2 + arrLoop, 3).Resize(1, 48)
With ActiveWorkbook.Worksheets(dmd).Range(price.Address)
.Offset(2 + arrLoop, 0) = strings(arrLoop)
.Offset(2 + arrLoop, 2) = "Price_" & dmd & "_" & strings(arrLoop)
.Offset(2 + arrLoop, 3).Resize(1, 48).Value = 0#
.Offset(2 + arrLoop, 3).Resize(1, 48).NumberFormat = "0.00"
End With
ActiveWorkbook.Names.Add Name:="price_" & dmd & "_" & strings(arrLoop), RefersToR1C1:= _
ActiveWorkbook.Worksheets(dmd).Range(price.Address).Offset(2 + arrLoop, 3).Resize(1, 48)

With ActiveWorkbook.Worksheets(dmd).Range(purchase.Address)
.Offset(2 + arrLoop, 0) = strings(arrLoop)
.Offset(2 + arrLoop, 2) = "Purchase_" & dmd & "_" & strings(arrLoop)
End With
ActiveWorkbook.Names.Add Name:="Purchase_" & dmd & "_" & strings(arrLoop), RefersToR1C1:= _
ActiveWorkbook.Worksheets(dmd).Range(purchase.Address).Offset(2 + arrLoop, 3).Resize(1, 48)

With ActiveWorkbook.Worksheets(dmd).Range(freight.Address)
.Offset(2 + arrLoop, 0) = strings(arrLoop)
.Offset(2 + arrLoop, 2) = "UFC_" & dmd & "_" & strings(arrLoop)
.Offset(2 + arrLoop, 3).Resize(1, 48).Value = 0#
.Offset(2 + arrLoop, 3).Resize(1, 48).NumberFormat = "0.00"
End With
ActiveWorkbook.Names.Add Name:="UFC_" & dmd & "_" & strings(arrLoop), RefersToR1C1:= _
ActiveWorkbook.Worksheets(dmd).Range(freight.Address).Offset(2 + arrLoop, 3).Resize(1, 48)
Next
' ElseIf frmAddSupply.Controls("cboSheets").Text Like "Supply*" Then
' strings = Split(sup, ", ")
' For arrLoop = 0 To UBound(strings)
' ActiveWorkbook.Worksheets(frmAddDemand.Controls("cboSheets").Text).Range(al loc.Address).Offset(2 + arrLoop, 0) = strings(arrLoop)
' ActiveWorkbook.Worksheets(frmAddDemand.Controls("cboSheets").Text).Range(al loc.Address).Offset(2 + arrLoop, 2) = "DemY_SupX" & arrLoop + 1 & "_Alloc"
' ActiveWorkbook.Worksheets(frmAddDemand.Controls("cboSheets").Text).Range(pr ice.Address).Offset(2 + arrLoop, 0) = strings(arrLoop)
' ActiveWorkbook.Worksheets(frmAddDemand.Controls("cboSheets").Text).Range(pr ice.Address).Offset(2 + arrLoop, 2) = "DemY_SupX" & arrLoop + 1 & "_Price"
' ActiveWorkbook.Worksheets(frmAddDemand.Controls("cboSheets").Text).Range(re venue.Address).Offset(2 + arrLoop, 0) = strings(arrLoop)
' ActiveWorkbook.Worksheets(frmAddDeamnd.Controls("cboSheets").Text).Range(re venue.Address).Offset(2 + arrLoop, 2) = "Rev_DemY_SupX" & arrLoop + 1
' Next
' End If
' ActiveWorkbook.Worksheets(frmAddDemand.Controls("cboSheets").Text).Visible = True
' ActiveWorkbook.Worksheets(frmAddDemand.Controls("cboSheets").Text).Range("b 2") = sup
ActiveWorkbook.Worksheets(sup).Range("b2").HorizontalAlignment = xlCenter
ActiveWorkbook.Worksheets(sup).Range("b2").Font.Bold = True
ActiveWorkbook.Worksheets(sup).Range("b2") = dmd
Unload Me
End If
End Sub
Private Sub UserForm_Activate()
Dim loopControl As Integer
Const checkht = 18
Const checkSpace = 3
Const checkLeft = 6
Const checkWidth = 120
Dim obj As Object
Dim idx As Integer
Dim vertButtons As Integer
Dim ws As Worksheet

Worksheets("Deal Selection").Activate
Application.ScreenUpdating = True
Application.Calculation = xlCalculationManual
formStatus = 1
Me.Width = 260
ActiveWorkbook.Worksheets("Supply X").Visible = False
ActiveWorkbook.Worksheets("Supply X1").Visible = False
ActiveWorkbook.Worksheets("Demand Y").Visible = False
For Each ws In ActiveWorkbook.Worksheets
' If LCase(ws.Name) <> LCase("Deal Selection") Then ws.Visible = False
' If LCase(ws.Name) <> LCase("Deal Selection") Then ws.Visible = True
Next
' me.Height =
' Set obj = Me.Controls.Add("forms.commandbutton.1")
Me.Controls("CanxButton").Left = checkLeft
Me.Controls("CanxButton").Width = 60
Me.Controls("CanxButton").Height = 20
Me.Controls("CanxButton").Caption = "Cancel"
' Me.Controls("CanxButton").Name = "CanxButton"
idx = 0
For loopControl = 9 To ThisWorkbook.ActiveSheet.Range("i" & ThisWorkbook.ActiveSheet.Rows.Count).End(xlUp).Row
idx = idx + 1
Me.Height = 55 + (checkht + checkSpace) * idx
Set obj = Me.Controls.Add("Forms.optionbutton.1")
obj.Name = "Demand" & idx
obj.Caption = ThisWorkbook.ActiveSheet.Cells(ThisWorkbook.ActiveSheet.Range(ThisWorkbook. ActiveSheet.Range("i" & ThisWorkbook.ActiveSheet.Rows.Count).End(xlUp).Address).End(xlUp).Row + idx, 2).Value
obj.Left = checkLeft
obj.Top = checkSpace + ((checkht + checkSpace) * (idx - 1))
obj.Width = checkWidth
Me.Controls("canxbutton").Top = obj.Top + (checkht + checkSpace)
Next
vertButtons = idx
idx = 0
For loopControl = 9 To ThisWorkbook.ActiveSheet.Range("b" & ThisWorkbook.ActiveSheet.Rows.Count).End(xlUp).Row
idx = idx + 1
Set obj = Me.Controls.Add("Forms.checkbox.1")
obj.Name = "Supply" & idx
obj.Caption = ThisWorkbook.ActiveSheet.Cells(ThisWorkbook.ActiveSheet.Range(ThisWorkbook. ActiveSheet.Range("i" & ThisWorkbook.ActiveSheet.Rows.Count).End(xlUp).Address).End(xlUp).Row + idx, 9).Value
obj.Left = 2 * checkLeft + checkWidth
obj.Top = checkSpace + ((checkht + checkSpace) * (idx - 1))
obj.Width = checkWidth
obj.Tag = obj.Caption
obj.Tag = Replace(obj.Tag, "+", "_plus")
obj.Tag = Replace(obj.Tag, "/", "_")
obj.Tag = Replace(obj.Tag, "-", "_")
obj.Tag = Replace(obj.Tag, " ", "_")
obj.Tag = Replace(obj.Tag, "(", "")
obj.Tag = Replace(obj.Tag, ")", "")
If idx > vertButtons Then
Me.Controls("canxbutton").Top = obj.Top + (checkht + checkSpace)
Me.Height = 55 + (checkht + checkSpace) * idx
End If
Next
' Set obj = Me.Controls.Add("forms.commandbutton.1")
Me.Controls("OKButton").Left = 2 * checkLeft + checkWidth
Me.Controls("OKButton").Caption = "OK"
Me.Controls("OKButton").Width = 60
Me.Controls("OKButton").Height = 20
Me.Controls("OKButton").Top = Me.Controls("canxbutton").Top
End Sub
Sub reform(ByRef state As Integer)
Dim ctrl As Control
Dim check As Integer
Dim opt As Boolean
Dim obj As Object
Dim ws As Worksheet
Dim sheetFound As Boolean

dmd = ""
sup = ""
For Each ctrl In frmAddDemand.Controls
If ctrl.Name Like "Demand*" Then
If ctrl.Value = True Then
opt = True
If dmd <> "" Then dmd = dmd & ", "
dmd = dmd & ctrl.Caption
End If
End If
Next
dmd = Replace(dmd, "+", "_plus")
dmd = Replace(dmd, "/", "_")
dmd = Replace(dmd, "-", "_")
dmd = Replace(dmd, " ", "_")
dmd = Replace(dmd, "(", "")
dmd = Replace(dmd, ")", "")
For Each ctrl In frmAddDemand.Controls
If ctrl.Name Like "Supply*" Then
If ctrl.Value = True Then
check = check + 1
If sup <> "" Then sup = sup & ", "
sup = sup & ctrl.Caption
Else
' Add check for pre-existence in chosen worksheet
If dmd <> "" Then
If wsExists(dmd) Then
If Not ThisWorkbook.Worksheets(sup).Range("I:I").Find(ctrl.Tag) Is Nothing Then
If sup <> "" Then sup = sup & ", "
sup = sup & ctrl.Caption
End If
End If
End If
End If
End If
Next
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, ")", "")
' If check > 4 Then
' state = 2
If opt And check >= 1 Then
state = 1
formStatus = 2
For Each ctrl In frmAddDemand.Controls
If ctrl.Name Like "Supply*" Or ctrl.Name Like "Demand*" Then
Me.Controls.Remove (ctrl.Name)
End If
Next
End If
' Add the dropdown
If formStatus = 2 Then
Set obj = Me.Controls.Add("forms.combobox.1")
obj.Left = 6
obj.Top = 6
obj.Width = 100
obj.Name = "cboSheets"
Me.Controls("OKButton").Top = 12 + obj.Height
Me.Controls("OKButton").Left = Me.Width / 2 + 6
Me.Controls("canxButton").Top = 12 + obj.Height
Me.Controls("canxButton").Left = Me.Width / 2 - 6 - Me.Controls("canxButton").Width
Me.Height = 80
sheetFound = False
For Each ws In ActiveWorkbook.Worksheets
' If LCase(ws.Name) <> LCase("Deal Selection") And _
LCase(ws.Name) <> LCase("supply x") And _
LCase(ws.Name) <> LCase("supply x1") And _
LCase(ws.Name) <> LCase("demand y") _
Then obj.AddItem (ws.Name)
' If LCase(ws.Name) = LCase("d_" & dmd) Then sheetFound = True
If LCase(ws.Name) = LCase(dmd) Then sheetFound = True
Next
' obj.AddItem ("d_" & dmd)
'Process sheetfound
If Not sheetFound Then
' Insert sheet as copy of demand y
' ThisWorkbook.Sheets("Demand Y").Activate
ThisWorkbook.Sheets("Demand Y").Copy After:=Sheets(ThisWorkbook.Sheets("Deal Selection").Index)
' ThisWorkbook.Sheets(ThisWorkbook.Sheets("Deal Selection").Index + 1).Name = "D_" & dmd
ThisWorkbook.Sheets(ThisWorkbook.Sheets("Deal Selection").Index + 1).Name = dmd
ThisWorkbook.Sheets(ThisWorkbook.Sheets("Deal Selection").Index + 1).Unprotect
ThisWorkbook.Sheets(ThisWorkbook.Sheets("Deal Selection").Index + 1).Visible = True
' obj.AddItem ("D_" & dmd)
End If
' obj.AddItem ("D_" & dmd)
obj.AddItem ("Demand")
obj.AddItem ("Supply")
' obj.Text = ("D_" & dmd)
obj.Text = "Demand"
End If
End Sub
Private Sub UserForm_Deactivate()
Application.ScreenUpdating = True
'Dim ws As Worksheet
'
' For Each ws In ActiveWorkbook.Worksheets
' ws.Visible = True
' Next
'
End Sub
Private Sub UserForm_Terminate()
Application.ScreenUpdating = True
'Dim ws As Worksheet
'
' For Each ws In ActiveWorkbook.Worksheets
' ws.Visible = True
' Next
'
End Sub
Sub checkRows(rowsNeeded As Integer)
Dim rowsnow As Integer
Dim rw As Long
Dim ws As Worksheet
Dim insrow As Integer
Dim processRow As Boolean
With ActiveWorkbook.Worksheets(sup)
For rw = .Range("i" & .Rows.Count).End(xlUp).Row To 1 Step -1
processRow = False
rowsnow = Application.WorksheetFunction.Min(.Range("i" & rw + 2).End(xlDown).Row, .Range("i" & .Rows.Count).End(xlUp).Row) - rw - 3
If LCase(.Range("i" & rw)) = LCase("Allocation") Then
rowsnow = 0
insrow = rw + 2
Do While .Range("i" & insrow) <> ""
insrow = insrow + 1
rowsnow = rowsnow + 1
Loop
rowsnow = rowsnow - 1
processRow = True
Set alloc = .Range("i" & rw)
ElseIf LCase(.Range("i" & rw)) = LCase("Price") Then
rowsnow = 0
insrow = rw + 2
Do While .Range("i" & insrow) <> ""
insrow = insrow + 1
rowsnow = rowsnow + 1
Loop
processRow = True
Set price = .Range("i" & rw)
ElseIf LCase(.Range("i" & rw)) = LCase("Unit Freight cost") Then
rowsnow = 0
insrow = rw + 2
Do While .Range("i" & insrow) <> ""
insrow = insrow + 1
rowsnow = rowsnow + 1
Loop
processRow = True
Set freight = .Range("i" & rw)
ElseIf LCase(.Range("i" & rw)) = LCase("Purchase Cost") Then
rowsnow = 0
insrow = rw + 2
Do While .Range("i" & insrow) <> ""
insrow = insrow + 1
rowsnow = rowsnow + 1
Loop
processRow = True
Set purchase = .Range("i" & rw)
ElseIf LCase(.Range("i" & rw)) = LCase("Revenue") Then
rowsnow = 0
insrow = rw + 2
Do While .Range("i" & insrow) <> ""
insrow = insrow + 1
rowsnow = rowsnow + 1
Loop
processRow = True
Set revenue = .Range("i" & rw)
End If
If processRow Then
If rowsNeeded > rowsnow Then
For insrow = 1 To rowsNeeded - rowsnow
.Range("i" & rw + 2).EntireRow.Insert
.Rows(rw + 3 & ":" & rw + 3).Copy Destination:=.Rows(rw + 2 & ":" & rw + 2)
Application.CutCopyMode = False
Next
ElseIf rowsNeeded < rowsnow Then
For insrow = 1 To rowsnow - rowsNeeded
.Range("i" & rw + 2).EntireRow.DELETE Shift:=xlUp
Next
End If
End If
Next
End With
End Sub
Function wsExists(ByVal ws As String) As Boolean
Dim sh As Worksheet
For Each sh In ThisWorkbook.Worksheets
If sh.Name = ws Then wsExists = True
Next
End Function
[/VBA]

[Simon Lloyd]

Keilah, please, when posting code highlight the entire code and click the green VBA button at the top of your post window it makes the code indented and easier to read.

For an idea of Undo look here