CODEWITHSUNDEEP
excelvba
Kaja
Kaja

Reputation: 3057

Reading a cell value in Excel vba and write in another Cell

I have an Excel file and I want to read a value of a cell i.e a cell contains (S:1 P:0 K:1 Q:1) I want to read each value and save each value to another column. For example if S:1, then should be another cell 1, how can I read the data from a cell and write in another cell with macro and vba?

Thank you for your helps

UPDATE:

Sub MacroF1()
usedRowCount = Worksheets("Übersicht_2013").UsedRange.Rows.Count
For i = 1 To usedRowCount
cellAYvalue = Worksheets("Übersicht_2013").Cells(i, "AY").Value
If InStr(cellvalue, "S: 1") <> 0 Then
Worksheets("Übersicht_2013").Cells(i, "BC") = 1
Else
Worksheets("Übersicht_2013").Cells(i, "BC") = 0
End If

If InStr(cellvalue, "P: 1") <> 0 Then
Worksheets("Übersicht_2013").Cells(i, "BD") = 1
Else
Worksheets("Übersicht_2013").Cells(i, "BD") = 0
End If

If InStr(cellvalue, "M: 1") <> 0 Then
Worksheets("Übersicht_2013").Cells(i, "BE") = 1
Else
Worksheets("Übersicht_2013").Cells(i, "BE") = 0
End If

If InStr(cellvalue, "L: 1") <> 0 Then
Worksheets("Übersicht_2013").Cells(i, "BF") = 1
Else
Worksheets("Übersicht_2013").Cells(i, "BF") = 0
End If

If InStr(cellvalue, "K: 1") <> 0 Then
Worksheets("Übersicht_2013").Cells(i, "BG") = 1
Else
Worksheets("Übersicht_2013").Cells(i, "BG") = 0
End If

If InStr(cellvalue, "Q: 1") <> 0 Then
Worksheets("Übersicht_2013").Cells(i, "BH") = 1
Else
Worksheets("Übersicht_2013").Cells(i, "BH") = 0
End If
'Worksheets("Übersicht_2013").Cells(i, "BC") = dd
'Worksheets("Übersicht_2013").Cells(i, "AY").Value
'Worksheets("Übersicht_2013").Range("BD44") = "Babak"
Next i

End Sub

Upvotes: 1

Views: 132048

Answers (3)

Our Man in Bananas
Our Man in Bananas

Reputation: 5981

surely you can do this with worksheet formulas, avoiding VBA entirely:

so for this value in say, column AV S:1 P:0 K:1 Q:1

you put this formula in column BC:

=MID(AV:AV,FIND("S",AV:AV)+2,1)

then these formulas in columns BD, BE...

=MID(AV:AV,FIND("P",AV:AV)+2,1)
=MID(AV:AV,FIND("K",AV:AV)+2,1)
=MID(AV:AV,FIND("Q",AV:AV)+2,1)

so these formulas look for the values S:1, P:1 etc in column AV. If the FIND function returns an error, then 0 is returned by the formula, else 1 (like an IF, THEN, ELSE

Then you would just copy down the formulas for all the rows in column AV.

HTH Philip

Upvotes: 2

matzone
matzone

Reputation: 5719

I have this function for this case ..

Function GetValue(r As Range, Tag As String) As Integer
Dim c, nRet As String
Dim n, x As Integer
Dim bNum As Boolean

c = r.Value
n = InStr(c, Tag)
For x = n + 1 To Len(c)
  Select Case Mid(c, x, 1)
    Case ":":    bNum = True
    Case " ": Exit For
    Case Else: If bNum Then nRet = nRet & Mid(c, x, 1)
  End Select
Next
GetValue = val(nRet)
End Function

To fill cell BC .. (assumed that you check cell A1)

Worksheets("Übersicht_2013").Cells(i, "BC") = GetValue(range("A1"),"S")

Upvotes: 2

rangan
rangan

Reputation: 44

The individual alphabets or symbols residing in a single cell can be inserted into different cells in different columns by the following code:

For i = 1 To Len(Cells(1, 1))
Cells(2, i) = Mid(Cells(1, 1), i, 1)
Next

If you do not want the symbols like colon to be inserted put an if condition in the loop.

Upvotes: 1

Related Questions