i wanted to replace value with the current value but it is not using this code ,please let me know

[ubaig]

i am working in excel sheet i have lot of data, i just wanted to replace value using this code but it is not replacing it

Dim wbi As Workbook
Dim tr As Long
Dim tc As Long


Dim A_BEGIN As Integer
Dim A_END As Integer
Dim CLM As Integer
Dim INPUT_WS As String
Dim settings_tab_present As String
Dim TYP As String
Dim cmnt As String, replace_val_col As Integer, addl_cols As Integer




Private Sub count_of_rc()
Set wbi = ActiveWorkbook
Range("A1").Select
Selection.CurrentRegion.Select
tr = Cells(1, 1).CurrentRegion.Rows.Count
tc = Cells(1, 1).CurrentRegion.Columns.Count
End Sub


Private Sub determine_attr_colno()
r = 3
Do While Trim(Worksheets("SETTINGS").Cells(r, 2)) <> ""
TMP = UCase(Trim(Worksheets("SETTINGS").Cells(r, 2)))
For c = 1 To tc
If TMP = UCase(Trim(Worksheets(INPUT_WS).Cells(1, c))) Then
Worksheets("SETTINGS").Cells(r, 5) = c
Exit For
End If
Next c
If c > tc Then
MsgBox Worksheets("SETTINGS").Cells(r, 2) + " - column not found in the Data sheet"
End
End If
r = r + 1
Loop


For c = 3 To 4
For rz = 3 To r
If Worksheets("SETTINGS").Cells(rz, c) <> "" Then
Exit For
End If
Next rz
If rz > r Then Exit For
Next c


replace_val_col = c + 1
If c = 3 Then addl_cols = 0
If c = 4 Then addl_cols = 1
If c = 5 Then addl_cols = 2


End Sub


Private Sub Settings()


'MsgBox ActiveWorkbook.Name
If UCase(Left(ActiveWorkbook.Name, 5)) = "TOOL" Then
MsgBox "Please open the Input File and choose Settings Option"
Exit Sub
End If
Set wbi = ActiveWorkbook
fnd = "N"
settings_tab_present = "N"
For Each ws In wbi.Worksheets ' ActiveWorkbook.Worksheets
If UCase(ws.Name) = "SETTINGS" Then
fnd = "Y"
Worksheets("SETTINGS").Activate
End If
Next ws
If fnd = "N" Then
wbi.Worksheets.Add
ActiveSheet.Name = "SETTINGS"
Cells(1, 1) = "CATEGORY =>"
Cells(1, 3) = "BLANK VALUES (Y/N) =>"

Cells(2, 1) = "COLUMN NAME"
Cells(2, 2) = "COLUMN VALUE"
Cells(2, 3) = "ADDITIONAL COLUMN 1"
Cells(2, 4) = "ADDITIONAL COLUMN 2"

Columns("A:F").Select
Selection.ColumnWidth = 16.43
Selection.ColumnWidth = 17.14
Range("A1:F1").Select
Selection.Font.Bold = True
Cells(2, 1).Select
End If
settings_tab_present = "Y"


End Sub


Private Sub List_uniq_val_FULLCELL()
If settings_tab_present <> "Y" Then
MsgBox "Please choose SETTINGS Option from Menu"
Exit Sub
End If


' check whether settings are given
If Trim(Worksheets("SETTINGS").Cells(1, 2)) = "" Then
Worksheets("SETTINGS").Activate
MsgBox "Please specify the Category column. 1st row 2nd column is blank in Settings Tab"
Exit Sub
End If


If UCase(ActiveSheet.Name) = "SETTINGS" Then
MsgBox "Please choose the input worksheet"
Exit Sub
End If


' determine total rows and columns of input
count_of_rc


INPUT_WS = ActiveSheet.Name


' determine category col number
categ_clm = 2
For c = 1 To tc
If UCase(Trim(Worksheets("SETTINGS").Cells(1, 2))) = UCase(Trim(Worksheets(INPUT_WS).Cells(1, c))) Then
categ_clm = c
Exit For
End If
Next c
If c > tc Then
MsgBox "Invalid Category specified in SETTINGS Tab"
Exit Sub
End If


' do validations here for settings
' check for uniqueness of attributes
' determine location of starting attribute column name


determine_attr_colno


' Check for the presence of output worksheet, if not create
Dim ws As Worksheet
fnd = "N"
For Each ws In ActiveWorkbook.Worksheets
If UCase(ws.Name) = "TOOL_OUTPUT" Then
fnd = "Y"
' if already data is present
If wbi.Worksheets("TOOL_OUTPUT").Cells(2, 1) <> "" Then
yesno = MsgBox("Data already present in Output Sheet. Replace it ? ", vbOKCancel)
If yesno = 1 Then
Worksheets("TOOL_OUTPUT").Activate
Cells.Select
Selection.Delete Shift:=xlUp
Range("A1").Select
Else
Exit Sub
End If
End If
Exit For
End If
Next ws
If fnd = "N" Then
ActiveWorkbook.Worksheets.Add
ActiveSheet.Name = "TOOL_OUTPUT"
End If


Worksheets("TOOL_OUTPUT").Cells(1, 1) = Worksheets("Settings").Cells(1, 2)
Worksheets("TOOL_OUTPUT").Cells(1, 2) = "Attribute"
Worksheets("TOOL_OUTPUT").Cells(1, 3) = "Value"
If addl_cols >= 1 Then Worksheets("TOOL_OUTPUT").Cells(1, 4) = "Addl Value 1"
If addl_cols = 2 Then Worksheets("TOOL_OUTPUT").Cells(1, 5) = "Addl Value 2"
Worksheets("TOOL_OUTPUT").Cells(1, replace_val_col) = "Replace Value"
If addl_cols >= 1 Then
Worksheets("TOOL_OUTPUT").Cells(1, replace_val_col + 1) = "Addl Col 1 - Replace Value "
End If
If addl_cols = 2 Then
Worksheets("TOOL_OUTPUT").Cells(1, replace_val_col + 2) = "Addl Col 2 - Replace Value "
End If


Worksheets("Settings").Activate


blank_val = Left(UCase(Trim(Worksheets("SETTINGS").Cells(1, 4))), 1)
'If Left(UCase(Trim(Worksheets("SETTINGS").Cells(1, 4))), 1) = "Y" Then
' blank_val = "Y"
'End If


dr = 2
r = 2
Do While r <= tr
sr = r
ID = Worksheets(INPUT_WS).Cells(r, categ_clm)
r = r + 1
Do While ID = Worksheets(INPUT_WS).Cells(r, categ_clm) And r <= tr
r = r + 1
Loop
er = r - 1

ir = 3
Do While Worksheets("SETTINGS").Cells(ir, 2) <> ""
c = Worksheets("SETTINGS").Cells(ir, 5)
'If (Left(UCase(Worksheets("SETTINGS").Cells(ir, 1)), 2) = "AT" And InStr(UCase(Worksheets("SETTINGS").Cells(ir, 1)), "L") > 0) And (Left(UCase(Worksheets("SETTINGS").Cells(ir, 2)), 2) = "AT" And InStr(UCase(Worksheets("SETTINGS").Cells(ir, 2)), "V") > 0) Then
If UCase(Trim(Worksheets("SETTINGS").Cells(ir, 1))) <> UCase(Trim(Worksheets("SETTINGS").Cells(ir, 2))) Then
atr = "Y"
Else
atr = "F"
End If


For r1 = sr To er
If atr = "Y" Then
If Worksheets(INPUT_WS).Cells(r1, c) <> "" Or (blank_val = "Y" And Worksheets(INPUT_WS).Cells(r1, c - 1) <> "") Then
Worksheets("Tool_Output").Cells(dr, 1) = Worksheets(INPUT_WS).Cells(r1, categ_clm)
Worksheets("Tool_Output").Cells(dr, 2) = Worksheets(INPUT_WS).Cells(r1, c - 1)
Worksheets("Tool_Output").Cells(dr, 3) = "'" + CStr(Worksheets(INPUT_WS).Cells(r1, c))
If addl_cols >= 1 Then
Worksheets("Tool_Output").Cells(dr, 4) = "'" + CStr(Worksheets(INPUT_WS).Cells(r1, c + 1))
End If
If addl_cols = 2 Then
Worksheets("Tool_Output").Cells(dr, 5) = "'" + CStr(Worksheets(INPUT_WS).Cells(r1, c + 2))
End If

dr = dr + 1
End If
Else
If Worksheets(INPUT_WS).Cells(r1, c) <> "" Or (blank_val = "Y") Then
Worksheets("Tool_Output").Cells(dr, 1) = Worksheets(INPUT_WS).Cells(r1, categ_clm)
Worksheets("Tool_Output").Cells(dr, 2) = Worksheets(INPUT_WS).Cells(1, c)
Worksheets("Tool_Output").Cells(dr, 3) = "'" + CStr(Worksheets(INPUT_WS).Cells(r1, c))
dr = dr + 1
End If
End If
Next r1

ir = ir + 1
Loop
Cells(1, 8) = "Processing . . " + Trim(CStr(er))
Loop
Cells(1, 8) = ""


'''''''''
Worksheets("Tool_Output").Activate
If addl_cols = 0 Then
Rng = "$A$1:$C$" + CStr(dr - 1)
ActiveSheet.Range(Rng).RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes
ElseIf addl_cols = 1 Then
Rng = "$A$1:$D$" + CStr(dr - 1)
ActiveSheet.Range(Rng).RemoveDuplicates Columns:=Array(1, 2, 3, 4), Header:=xlYes
ElseIf addl_cols = 2 Then
Rng = "$A$1:$E$" + CStr(dr - 1)
ActiveSheet.Range(Rng).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), Header:=xlYes
End If


'Cells(1, 5) = "Delete Y/N"


Columns("A:G").Select
Selection.ColumnWidth = 21
Rows("1:1").Select
Selection.Font.Bold = True


MsgBox "Done"


End Sub


Private Sub REPLACE_VALUES_fullcell()
ans = MsgBox("Is the Input Data worksheet sorted on Category ?", vbYesNo)
If ans <> 6 Then
MsgBox "Please sort the input data worksheet on category"
End
End If


n = 2
'Application.Cursor = xlWait


INPUT_WS = UCase(ActiveSheet.Name)
If INPUT_WS = "SETTINGS" Or INPUT_WS = "TOOL_OUTPUT" Then
MsgBox "Please select the Input Data Sheet"
End
End If


count_of_rc


categ_clm = 2
For c = 1 To tc
If UCase(Trim(Worksheets("Settings").Cells(1, 2))) = UCase(Trim(Worksheets(INPUT_WS).Cells(1, c))) Then
categ_clm = c
Exit For
End If
Next c
If c > tc Then
MsgBox "Invalid Category specified in SETTINGS Tab"
End
End If


' attrs in the header
determine_attr_colno


' determine first col of attr label
sc = Worksheets("SETTINGS").Cells(3, 5)
'For c = 1 To tc
'If Left(Trim(UCase(Worksheets(INPUT_WS).Cells(1, c))), 2) = "AT" And (InStr(Trim(UCase(Worksheets(INPUT_WS).Cells(1, c))), "LAB") > 0 Or InStr(Trim(UCase(Worksheets(INPUT_WS).Cells(1, c))), "LBL") > 0 Or InStr(Trim(UCase(Worksheets(INPUT_WS).Cells(1, c))), "NAM")) And InStr(Trim(UCase(Worksheets(INPUT_WS).Cells(1, c))), "1") > 0 Then
' sc = c
' Exit For
' End If
'Next c


Dim atr(200, 2) 'As String
r = 3
vmax = 0
'Do While Worksheets("Settings").Cells(r, 2) <> ""
If Not (Left(Trim(UCase(Worksheets("SETTINGS").Cells(r, 1))), 2) = "AT" And _
Left(Trim(UCase(Worksheets("SETTINGS").Cells(r, 2))), 2) = "AT") Then
atr(vmax, 0) = Trim(Worksheets("Settings").Cells(r, 1))
atr(vmax, 1) = Trim(Worksheets("Settings").Cells(r, 5))
vmax = vmax + 0

End If
r = r + 1
'Loop
vmax = vmax - 1


r = 2
Worksheets("Tool_Output").Select
tcz = Cells(1, 1).CurrentRegion.Columns.Count
Cells(1, tcz + 1) = "Tool_Remarks"


If UCase(Trim(Worksheets("SETTINGS").Cells(3, 1))) <> UCase(Trim(Worksheets("SETTINGS").Cells(3, 2))) Then
vatr = "Y"

' determine step atr step value
' stpval = 0
' For c = sc To tc
' If Left(Trim(UCase(Worksheets(INPUT_WS).Cells(1, c))), 2) = "AT" And (InStr(Trim(UCase(Worksheets(INPUT_WS).Cells(1, c))), "LAB") > 0 Or InStr(Trim(UCase(Worksheets(INPUT_WS).Cells(1, c))), "LBL") > 0 Or InStr(Trim(UCase(Worksheets(INPUT_WS).Cells(1, c))), "NAM")) And InStr(Trim(UCase(Worksheets(INPUT_WS).Cells(1, c))), "2") > 0 Then
' stpval = c - sc
' Exit For
' End If
' Next c
stpval = Worksheets("SETTINGS").Cells(4, 5) - sc
If stpval <= 0 Then
MsgBox "Unable to determine attribute step value"
End
End If

Else
vatr = "F"
End If


If vatr = "F" Then


FRSTIME = 1
sr = 0
Do While Cells(r, 1) <> ""

If Trim(Cells(r, replace_val_col)) <> "" Then 'Or UCase(Cells(r, 5)) = "Y"
If ID <> Trim(Cells(r, 1)) Or FRSTIME = 1 Then
ID = Trim(Cells(r, 1))
FRSTIME = 0
' determine row number of category
For r1 = 2 To tr
If Trim(UCase(Worksheets(INPUT_WS).Cells(r1, categ_clm))) = UCase(ID) Then
sr = r1
Exit For
End If
Next r1
End If
'''''''''''''''''''''''''''

rz = sr
id2 = ""
CLM = 0
Do While Trim(UCase(Worksheets(INPUT_WS).Cells(rz, categ_clm))) = UCase(ID)
If id2 <> Trim(Cells(r, 2)) Then
id2 = Trim(Cells(r, 2))
CLM = 0
For n = 0 To vmax
If id2 = atr(n, 0) Then
CLM = atr(n, 1)
Exit For
End If
Next n
End If

If CLM <> 0 Then
If CStr(Worksheets(INPUT_WS).Cells(rz, CLM)) = CStr(Cells(r, 3)) Then
Worksheets(INPUT_WS).Cells(rz, CLM) = "'" + Trim(CStr(Cells(r, replace_val_col)))
Cells(r, tcz + 1) = "Done"
End If
End If
rz = rz + 1
Loop

End If
r = r + 1
Cells(r, replace_val_col).Select
Loop




Else


FRSTIME = 1
sr = 0
Do While Cells(r, 1) <> ""

If Trim(Cells(r, replace_val_col)) <> "" Then 'Or UCase(Cells(r, 5)) = "Y"
If CStr(ID) <> CStr(Cells(r, 1)) Then
ID = Trim(Cells(r, 1))
FRSTIME = 0
' determine row number of category
For r1 = 2 To tr
If Trim(UCase(Worksheets(INPUT_WS).Cells(r1, categ_clm))) = UCase(ID) Then
sr = r1
Exit For
End If
Next r1
End If
'''''''''''''''''''''''''''

rz = sr
Do While CStr(Worksheets(INPUT_WS).Cells(rz, categ_clm)) = CStr(ID)
For cz = sc To tc Step stpval
'If Worksheets(INPUT_WS).Cells(rz, cz) = "" Then Exit For
If CStr(Worksheets(INPUT_WS).Cells(rz, cz)) = CStr(Cells(r, 2)) And CStr(Worksheets(INPUT_WS).Cells(rz, cz)) = CStr(Cells(r, 3)) And addl_cols = 0 Then
Worksheets(INPUT_WS).Cells(rz, cz) = "'" + Trim(CStr(Cells(r, replace_val_col)))
If Worksheets(INPUT_WS).Cells(rz, tc + 1) = "" Then
Worksheets(INPUT_WS).Cells(rz, tc + 1) = "'" + Trim(CStr(Cells(r, replace_val_col)))
Else
Worksheets(INPUT_WS).Cells(rz, tc + 1) = CStr(Worksheets(INPUT_WS).Cells(rz, tc + 1)) + " | " + Trim(CStr(Cells(r, replace_val_col)))
End If
Cells(r, tcz + 1) = "Done"

ElseIf CStr(Worksheets(INPUT_WS).Cells(rz, cz)) = CStr(Cells(r, 2)) And CStr(Worksheets(INPUT_WS).Cells(rz, cz)) = CStr(Cells(r, 3)) And CStr(Worksheets(INPUT_WS).Cells(rz, cz + 1)) = CStr(Cells(r, 4)) And addl_cols = 1 Then
Worksheets(INPUT_WS).Cells(rz, cz) = "'" + Trim(CStr(Cells(r, replace_val_col)))
vAddVal = ""
If Cells(r, replace_val_col + 1) <> "" Then
Worksheets(INPUT_WS).Cells(rz, cz + 1) = "'" + Trim(CStr(Cells(r, replace_val_col + 1)))
vAddVal = " " + Trim(CStr(Cells(r, replace_val_col + 1)))
End If
If Worksheets(INPUT_WS).Cells(rz, tc + 1) = "" Then
Worksheets(INPUT_WS).Cells(rz, tc + 1) = "'" + Trim(CStr(Cells(r, replace_val_col))) + vAddVal
Else
Worksheets(INPUT_WS).Cells(rz, tc + 1) = CStr(Worksheets(INPUT_WS).Cells(rz, tc + 1)) + " | " + Trim(CStr(Cells(r, replace_val_col))) + vAddVal
End If
Cells(r, tcz + 1) = "Done"
ElseIf CStr(Worksheets(INPUT_WS).Cells(rz, cz)) = CStr(Cells(r, 2)) And CStr(Worksheets(INPUT_WS).Cells(rz, cz)) = CStr(Cells(r, 3)) And CStr(Worksheets(INPUT_WS).Cells(rz, cz + 1)) = CStr(Cells(r, 4)) And CStr(Worksheets(INPUT_WS).Cells(rz, cz + 2)) = CStr(Cells(r, 5)) And addl_cols = 2 Then
Worksheets(INPUT_WS).Cells(rz, cz) = "'" + Trim(CStr(Cells(r, replace_val_col)))
vAddVal = ""
If Cells(r, replace_val_col + 1) <> "" Then
Worksheets(INPUT_WS).Cells(rz, cz + 1) = "'" + Trim(CStr(Cells(r, replace_val_col + 1)))
vAddVal = " " + Trim(CStr(Cells(r, replace_val_col + 1)))
End If
If Cells(r, replace_val_col + 2) <> "" Then
Worksheets(INPUT_WS).Cells(rz, cz + 2) = "'" + Trim(CStr(Cells(r, replace_val_col + 2)))
vAddVal = vAddVal + " " + Trim(CStr(Cells(r, replace_val_col + 1)))
End If
If Worksheets(INPUT_WS).Cells(rz, tc + 1) = "" Then
Worksheets(INPUT_WS).Cells(rz, tc + 1) = "'" + Trim(CStr(Cells(r, replace_val_col))) + vAddVal
Else
Worksheets(INPUT_WS).Cells(rz, tc + 1) = CStr(Worksheets(INPUT_WS).Cells(rz, tc + 1)) + " | " + Trim(CStr(Cells(r, replace_val_col))) + vAddVal
End If
Cells(r, tcz + 1) = "Done"
End If
Next cz
rz = rz + 1
Loop

End If
r = r + 1
Cells(r, replace_val_col).Select
Loop


End If
Worksheets(INPUT_WS).Cells(1, tc + 1) = "Replaced values"


''''''''''''''''''''''''''''''''


'Application.Cursor = xlDefault
MsgBox "Done"


End Sub


Private Sub CHECK_COL_TYPE()
ir = 2
Do While Worksheets("SETTINGS").Cells(ir, 2) <> ""
If Worksheets("SETTINGS").Cells(ir, 2) = TYP Then
TYP = "OTH"
CLM = Worksheets("SETTINGS").Cells(ir, 4)
Exit Do
End If
ir = ir + 1
Loop
End Sub


Private Sub Channelize_1()
List_uniq_val_FULLCELL
End Sub


Private Sub Channelize_2()
If settings_tab_present <> "Y" Then
MsgBox "Please choose SETTINGS Option"
Exit Sub
End If


REPLACE_VALUES_fullcell


End Sub


Private Function check_dupl(check_str As String)
cmnt = ""
w = Split(check_str, Worksheets("SETTINGS").Cells(2, 6))
fnd = "N"
For C1 = 0 To UBound(w) - 1
If w(C1) = "" Then GoTo 500
For C2 = C1 + 1 To UBound(w)
If w(C1) = w(C2) Then
w(C2) = ""
fnd = "Y"
End If
Next C2
500
Next C1

' to remove dupl
If fnd = "Y" Then
catstr = ""
For C1 = 0 To UBound(w)
If w(C1) <> "" Then
If catstr = "" Then
catstr = w(C1)
Else
catstr = catstr + Worksheets("SETTINGS").Cells(2, 6) + w(C1)
End If
End If
Next C1
cmnt = "Duplicates removed"
End If
check_dupl = check_str


End Function


End Function

----------------------------------------------------

Private Sub AddMenus()
Dim cbMainMenuBar As CommandBar
Dim iVeiwMenu As Integer
Dim cbcCustomMenu As CommandBarControl


On Error Resume Next
Application.CommandBars("Worksheet Menu Bar").Controls("&Identify Uniques").Delete
On Error GoTo 0


Set cbMainMenuBar = Application.CommandBars("Worksheet Menu Bar")
iVeiwMenu = cbMainMenuBar.Controls("View").Index


Set cbcCustomMenu = cbMainMenuBar.Controls.Add(Type:=msoControlPopup, Before:=iVeiwMenu)
cbcCustomMenu.Caption = "&Identify Uniques"

With cbcCustomMenu.Controls.Add(Type:=msoControlButton)
.Caption = "Settings"
.OnAction = "Settings"
End With


With cbcCustomMenu.Controls.Add(Type:=msoControlButton)
.Caption = "List Unique Values"
.OnAction = "CHANNELIZE_1"
End With


'With cbcCustomMenu.Controls.Add(Type:=msoControlButton)
' .Caption = "Get MRG Values"
' .OnAction = "Get_MRG_Values"
'End With


With cbcCustomMenu.Controls.Add(Type:=msoControlButton)
.Caption = "Replace Values"
.OnAction = "CHANNELIZE_2"
End With


End Sub


Private Sub DeleteMenu()
On Error Resume Next
Application.CommandBars("Worksheet Menu Bar").Controls("&New Menu").Delete
On Error GoTo 0
End Sub