Changing data format and create other, alterative data

[stakar]

I have the following text formatted numeric data in column A

A
------
00
010100
0010
1025
0000
1025
010
020
05
000
510
140510
0010

Here's the code for the above

code:
--------------------------------------------------------------------------------

Set rng = Range([BH4], [A65536].End(xlUp)(1, 60))
Set CheckboxRange = [A1:BG1].SpecialCells(xlCellTypeConstants, 2)
For Each ThisCell In CheckboxRange
s = s & "&" & ThisCell(4).Address(False, False)
Next ThisCell
Application.ScreenUpdating = False
rng.ClearContents
[BH4] = "=" & Mid(s, 2, Len(s) - 1)
[BH4].Copy rng
rng.Copy
rng.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True

--------------------------------------------------------------------------------
I need to add a vb code to the above that :

When a type e.g. an "X" in the cell A1 it will NOT write the column's
results but it will
format column's A data to numbers and then it will write a column
using the condition:
If the cell in column A is "> 0" then the result will be 1 else it wil
be 0.

This is what i ll get

A B
-------------
00 0
010100 1
0010 1
1025 1
0000 0
1025 1
010 1
020 1
05 1
000 0
510 1
140510 1
0010 1

--------------------------------------------------------------------------------
Otherwise when the cell is null (without the "X") the result will com
from the code
i wrote and i ll get column's A result


Thanks in advance
****************************
Stathis
Patras Greec

 

[Frank Kabel]

Hi
not sure I fully understood your requirements but try the following
event procedure (put it in your worksheet module):

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.count > 1 Then Exit Sub
If Application.Intersect(Target, Range("A:A")) Is _
Nothing Then Exit Sub

On Error GoTo ErrorHandler
Application.EnableEvents = False
With Target
If .Value = "X" Then
Application.Undo
.NumberFormat = "000"
If .Value > 0 Then
.Offset(0, 1).Value = 1
Else
.Offset(0, 1).Value = 0
End If
End If
End With
ErrorHandler:
Application.EnableEvents = True
End Sub

 

[stakar]

Frank thanks for the quick replay and
let me be more specific.
The following code concatenate cells that their columns are checked.
-----------------------------------------------------------------------------
Private Sub CommandButton1_Click()

Set rng = Range([BH4], [A65536].End(xlUp)(1, 60))
Set CheckboxRange = [A1:BG1].SpecialCells(xlCellTypeConstants, 2)
For Each ThisCell In CheckboxRange
s = s & "&" & ThisCell(4).Address(False, False)
Next ThisCell
Application.ScreenUpdating = False
rng.ClearContents
[BH4] = "=" & Mid(s, 2, Len(s) - 1)
[BH4].Copy rng
rng.Copy
rng.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
-------------------------------------------------------------------------

Then pass the data to the column BH and specific to the cell BH4 an
fill it all the
way down till the end of the range with the data of the concatenate
cells.

Example:

@ @ @
A B D E
----------
0 0 1 0
0 4 0 4
1 0 0 4
2 1 0 1
0 0 0 0
5 0 1 1
7 1 0 0

The result of the checked columns A , B & E is

BH
---
000
044
104
211
000
501
700

What I want is ...
After the calculation and before the code "writes" the data to th
column BH to check if a cell
eg. BI1 is checked with an "X" .If its true then it has to alter th
data to 1 or 0 depending on BH
cell value and then to "write" the altered data.
If the result is bigger than 1 then it will be 1 or if it isnot it wil
be 0.

So, for the above example, we would get the following results

BH
---
0
1
1
1
0
1
1

I hope you understand now!

 

[Frank Kabel]

Hi
try the following (not the best way but it should do):

Private Sub CommandButton1_Click()
Dim cell as range

Set rng = Range([BH4], [A65536].End(xlUp)(1, 60))
Set CheckboxRange = [A1:BG1].SpecialCells(xlCellTypeConstants, 2)
For Each ThisCell In CheckboxRange
s = s & "&" & ThisCell(4).Address(False, False)
Next ThisCell
Application.ScreenUpdating = False
rng.ClearContents
[BH4] = "=" & Mid(s, 2, Len(s) - 1)
[BH4].Copy rng
rng.Copy
rng.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

For each cell in rng
if cell.offset(0,1).value="X" and cell.value <>"" then
if cell.value > 1 then
cell.value = 1
else
cell.value = 0
end if
end if
next

Application.ScreenUpdating = True

 

[stakar]

Thanks Frank,
its a little bit slow because it changes the cells one by one but i
works just ok!

Thanks for your help!!!
See you around soon !