PDA

View Full Version : [SOLVED] To insert formula in specific cell with VBA



alexxgalaxy
10-14-2011, 03:56 AM
If I have a speadsheet with two colums of data. Each column has data of 1000 rows (could vary in length). If I want to insert formula in specifc cells (see below++) within the two columns, what would VBA code be?

++
1. Blank cells
2. Cells with certain value, suach as "0", "XYZ"
3. When the value of other cells, let say, the cell in the same row in column A, is "0", start with "XZY", equal to "XZY", or end with "XZY".
4. The activecell is blank while the value of other cells, let say, the cell in the same row in column A, is "0", start with "XZY", equal to "XZY", or end with "XZY".

For instance, cells B3:B20 are filled in, B21 is blank, B22:B70 are filled in, B71's value is "0", e.t.c.

Thanks.

Kenneth Hobs
10-14-2011, 10:52 PM
I don't understand. What sort of formula did you want to add? Where is it to be added? Is it to replace the cells that meet the criterion? A Select Case solution is easily used for this scenario.

alexxgalaxy
10-15-2011, 03:54 AM
I don't understand. ...

Sorry for not making things clear. I just figured out the code myself. Here are the codes I came up with. Either of first two codes can do what I want, so far. Thanks for the reply, Kenneth. :)



Sub Test2()
Range("B1").select
Do
If Left(ActiveCell.Offset(0, -1).Value, 3) = "ABC" And IsEmpty(ActiveCell) Then
ActiveCell.Value = "XYZ"
End If
ActiveCell.Offset(1, 0).Select
Loop Until IsEmpty(ActiveCell.Offset(0, -1))
End Sub

Sub Test3()
Dim i As Integer
Dim intRowCount As Integer
intRowCount = Range("A1").CurrentRegion.Rows.Count -
Range("B1").select
For i = 1 To intRowCount
If Left(ActiveCell.Offset(0, -1).Value, 3) = "ABC" And IsEmpty(ActiveCell) Then
ActiveCell.Value = "XYZ"
End If
ActiveCell.Offset(1, 0).Select
Next i
End Sub



I came across with error for this one though. It would be great if you could help correct the code


Sub Test1()
Dim Rng As Range, r As Range
Set Rng =Range("B1", Range("B1000").End(xlUp)
For Each r In Rng.Areas
If Left(r.Offset(0, -1).Value, 3) = "TCI" And IsEmptyŽ Then
r.Value = "XYZ"
End If
Next
End Sub

shrivallabha
10-15-2011, 09:05 AM
For starter, change


Set Rng =Range("B1", Range("B1000").End(xlUp)

To:


Set Rng =Range("B1", Range("B1000").End(xlUp))

Kenneth Hobs
10-15-2011, 10:34 AM
The 2nd Case is just an example. Add as many Cases as you need.


Option Explicit
'http://vbaexpress.com/kb/getarticle.php?kb_id=1035
Public glb_origCalculationMode As Integer

Sub testKen()
'1. Blank cells
'2. Cells with certain value, suach as "0", "XYZ"
'3. When the value of other cells, let say, the cell in the same row in column A, is "0", _
start with "XZY", equal to "XZY", or end with "XZY".
'4. The activecell is blank while the value of other cells, let say, _
the cell in the same row in column A, is "0", start with "XZY", equal to "XZY", or end with "XZY".
Dim cell As Range
On Error GoTo EndSub
SpeedOn
For Each cell In Range("B3", Range("B" & Rows.Count).End(xlUp))
Select Case True
Case Left(Range("A" & cell.Row).Value2, 3) = "TCI" And IsEmpty(cell)
cell.Value2 = "XYZ"
Case Right(Range("A" & cell.Row).Value2, 3) = "XYZ" And IsEmpty(cell)
cell.Value2 = "Right 3 is XYZ"
Case Else
'something if nothing is true
End Select
Next cell
EndSub:
SpeedOff
End Sub

Sub SpeedOn(Optional StatusBarMsg As String = "Running macro...")
glb_origCalculationMode = Application.Calculation
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.Cursor = xlWait
.StatusBar = StatusBarMsg
.EnableCancelKey = xlErrorHandler
End With
End Sub

Sub SpeedOff()
With Application
.Calculation = glb_origCalculationMode
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.CalculateBeforeSave = True
.Cursor = xlDefault
.StatusBar = False
.EnableCancelKey = xlInterrupt
End With
End Sub

alexxgalaxy
10-15-2011, 05:55 PM
For starter, change


Thanks Shrivallabha!

alexxgalaxy
10-15-2011, 06:11 PM
The 2nd Case is just an example. Add as many Cases as you need.

Thanks Kenneth, especially for introducing me the Speedon codes. It does help speed things up. It's awesome! :thumb

I tested the codes on following columns, everything went well except for the cell highlighted in red. It seems to fit the condition set in Case 2 but the returned result said otherwise. :think:

Column A
TCI-646541
TCI-646542
TCI-646543
TCI-646544
646XYZ
646XYZ
TCI-646547
TCI-646545
TCI-646546
XYZ-646XYZ
TCI-646548
TCI-646549

Column B
APAC4654 (not a blank cell originally)
XYZ (returned result)
XYZ (returned result)
Right 3 is XYZ (returned result)
Right 3 is XYZ (returned result)
XYZ (returned result)
XYZ (returned result)
SV#jfda (not a blank cell originally)
(Blank)
(Blank)
(Blank)

Kenneth Hobs
10-16-2011, 06:03 AM
I could not duplicate your problem. Try posting the workbook. The routine will only match the first true condition.

frank_m
10-16-2011, 12:36 PM
Being that some cells in Column B be might be empty,
Shouldn't the last row be determined from column A instead of B ?

Maybe this:


For Each cell In Range("B3", Range("A" & Rows.Count).End(xlUp))

alexxgalaxy
10-16-2011, 06:18 PM
Being that some cells in Column B be might be empty,


You're right. Thanks for point that out. :thumb I've changed the the code as follows, provided column A is the column that will not have empty cell in the table.


For Each cell In Range("A1", Range("A" & Rows.Count).End(xlUp).Offset(0, 1))

alexxgalaxy
10-16-2011, 06:19 PM
I could not duplicate your problem. Try posting the workbook. The routine will only match the first true condition.

Thanks Ken. As frank_m pointed out, the issue has been fixed now. Thank so much for the help! :thumb