I've got a macro that works perfectly but that I now need to customize it and add complexity.
The macro is basically the following code repeated numerous times for a variety of ranges.
For i = 2 To n
Range(Cells(13, i), Cells(19, i)).Value = Sheets(i).Range("J13:J19").Value
Next i
The logic/complexity that I need to add to this should go as follows:
if the sum of the range O13:O19 on sheet i is greater than zero, then the value of the range cells(13,i),cells 19,i) on this sheet are equal to the value of the range p13:p19 on sheet i.
If the value of the sum of range O13:O19 on sheet i is not greater than 0, then set the value of the target range equal to each cell in (range sheet(i).range("I13:I19")-sheet(i).range("K13:K19")*4).value
In simpler terms, if the sum of the range is 0, set the value of every cell in range A to the value of every cell in range b less the (value of every cell in range C * 4)...
Sub Op_ex_analysis_macro()
ActiveWorkbook.Sheets.Add Before:=Worksheets(1)
ActiveSheet.Name = "Control Panel"
Range("A:A").ColumnWidth = 36
Range("A12").Value = "Property Code"
Range("A13:A16") = Sheets(2).Range("A13:A16").Value
Range("A17") = Sheets(2).Range("B17").Value
Range("A18") = Sheets(2).Range("A18").Value
Range("A19") = Sheets(2).Range("B19").Value
Range("A20:A29") = Sheets(2).Range("A21:A30").Value
Range("A30") = Sheets(2).Range("B31").Value
Range("A31") = Sheets(2).Range("A33").Value
Range("A32:A36") = Sheets(2).Range("A35:A39").Value
Range("A37:A38") = Sheets(2).Range("A41:A42").Value
Range("A40").Value = "Analyst"
Range("A41").Value = "Number of Units"
Range("A42").Value = "Asset Manager"
Range("A43").Value = "Tenancy"
Range("A44").Value = "Year Built/Type"
Range("A45").Value = "Management Company"
Range("A46").Value = "End of Compliance Year"
Range("A47").Value = "Property Name"
Range("A48").Value = "Number of Properties"
Range("A49").Value = "City"
Range("A50").Value = "State"
'Consolidate Property Codes
n = ActiveWorkbook.Sheets.Count
For i = 2 To n
Z = Sheets(i).Range("P49").Value
Cells(12, i) = Z
Next i
'Consolidate rows 13-19
For i = 2 To n
Select Case Application.Sum(ThisWorkbook.Sheets(i).Range("O13:O33"))
Case Is > 0
Range(Cells(13, i), Cells(19, i)).Value = Sheets(i).Range("P13:P19").Value
Case Is = 0
Range(Cells(13, i), Cells(19, i)).Value = ThisWorkbook.Sheets(i).Range("I13:I19") - ThisWorkbook.Sheets(i).Range("K13:K19") * 4
End Select
Next i
In this case i think the best option is to use a Select case statement.
For i = 2 To n
Select Case Application.Sum(ThisWorkbook.Sheets(i).Range("O13:O33"))
Case Is > 0
Range(Cells(13, i), Cells(19, i)).Value = Sheets(i).Range("P13:P19").Value
Case Is < 0
Range(Cells(13, i), Cells(19, i)).Value = ThisWorkbook.Sheets(i).Range("I13:I19") - ThisWorkbook.Sheets(i).Range("K13:K19") * 4
End Select
Next i
Hope this helps :)
EDIT If ou want to account for whent it's "0" then just add a Case Is 0
After a lot of trial and error, I was able to solve the problem through via a different route.
As A.S.H correctly noted above, you can't do arithmetic on VBA arrays.
The first half of my code was basically moving an array, as Scott Craner noted on a different page, which is simple.
Directing VBA to perform calculations requires the coder to send the formula through a range cell by cell.
Ultimately, the code that performed as required was as follows:
Dim rng As Range
n = ActiveWorkbook.Sheets.Count
With ActiveSheet
For i = 2 To n
If Application.Sum(Sheets(i).Range("O13:O33")) > 0 Then
.Range(.Cells(13, i), .Cells(19, i)).Value = Sheets(i).Range("P13:P19").Value
Else
For Each rng In .Range(.Cells(13, i), .Cells(19, i))
rng.Value = Sheets(i).Cells(rng.Row, "I") - (4 * Sheets(i).Cells(rng.Row, "K"))
Next rng
End If
Next i
End With
If the condition of the first 1/2 of the if statement is met, then it's just set these values equal to those values. If the condition is not met, then the Else statement directs Excel to move through the range performing the calculation as it goes.
Related
I want to automate a calculation for a measurement data Excel file.
While I made the function work, I could only figure out how to do that for one row at a time. The calculation is specific to the data on every row.
I thought I could change the Range("J3") value to Range("J3:J52") for a capacity of 50 calculations.
How do I make the function calculate for every row, separately, using the data of said specific row?
It doesn't matter if it runs for all 50 rows or if I have to figure out some loop function to find how many rows to calculate for, as long as one button press in the end will make the magic happen.
I have included a screenshot of the sheet for reference, the main calculation is done in Excel, but what this is doing is choosing the correct option out of a few different correction calculations and explaining to the user why.
I think there are some unnecessary Dim lines at the start but if it runs, I wasn't going to remove them.
'The main function, activated by a simple button Sub'
Function ISO16032()
'DeltaL Range'
Dim DeltaL As Range
Set DeltaL = Range("F3")
'Result is the corrected value in G column'
Dim Result As Long
'Note is the calc note in H column'
Dim Note As String
'X is the DeltaL between noise and background noise'
Dim x As Long
x = Range("F3").Value
Select Case Range("F3").Value
'No correction when X = > 10'
Case 10.6 To 200
Result = Range("J3")
Range("G3").Value = Result
Note = "No correction"
Range("H3").Value = Note
'Correction according to ISO16032 when X = between 4 and 10'
Case 3.6 To 10.5
Result = Range("K3")
Range("G3").Value = Result
Note = "Correction per ISO16032"
Range("H3").Value = Note
'Maximal correction value set to 2,2 dB if X < 4'
Case 0.1 To 3.5
Result = Range("L3")
Range("G3").Value = Result
Note = "Correction limit set to 2,2 dB"
Range("H3").Value = Note
'If x = < 0, the measurement is invalid'
Case Else
Note = "Repeat measurement!"
Range("H3").Value = Note
End Select
End Function
Hi and welcome to stackoverflow, I think that a simple loop, with the addition of an argument to your ISO function allows you to solve your problem like this
Sub Looping()
For i = 3 To 52
' Convert i to String because we need to concatenate with the letter F, G, H...
Call ISO16032(CStr(i))
Next
End Sub
Function ISO16032(Cell_X)
'DeltaL Range'
Dim DeltaL As Range
Set DeltaL = Range("F" + Cell_X)
'Result is the corrected value in G column'
Dim Result As Long
'Note is the calc note in H column'
Dim Note As String
'X is the DeltaL between noise and background noise'
Dim x As Long
x = Range("F" + Cell_X).Value
Select Case Range("F" + Cell_X).Value
'No correction when X = > 10'
Case 10.6 To 200
Result = Range("J" + Cell_X)
Range("G" + Cell_X).Value = Result
Note = "No correction"
Range("H" + Cell_X).Value = Note
'Correction according to ISO16032 when X = between 4 and 10'
Case 3.6 To 10.5
Result = Range("K" + Cell_X)
Range("G" + Cell_X).Value = Result
Note = "Correction per ISO16032"
Range("H" + Cell_X).Value = Note
'Maximal correction value set to 2,2 dB if X < 4'
Case 0.1 To 3.5
Result = Range("L" + Cell_X)
Range("G" + Cell_X).Value = Result
Note = "Correction limit set to 2,2 dB"
Range("H" + Cell_X).Value = Note
'If x = < 0, the measurement is invalid'
Case Else
Note = "Repeat measurement!"
Range("H" + Cell_X).Value = Note
End Select
End Function
EDIT: think indented your code like I did to make it more readable too (or like #Darren Bartrup-Cook did when editing your question)
This is more of an example of how to calculate each row.
Just getting your code to work across multiple rows.
Cells
With...End With Statement
'No need for Sub to call function that doesn't return anything.... just write a sub.
Public Sub ISO16032()
Dim LastRow As Long
With ThisWorkbook.Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, 10).End(xlUp).Row
Dim RowCounter As Long
Dim Result As Long
Dim Note As String
'Only calculate if there is data in rows 3 onwards.
If LastRow >= 3 Then
'Reset results on each pass.
'Assuming -1 is an impossible answer so code knows
'not to put anything on Case Else.
Result = -1
Note = ""
'Cycle through each row and calculate.
For RowCounter = 3 To LastRow
Select Case .Cells(RowCounter, 6) 'Look at column F(column 6) on each row.
Case 10.6 To 200
Result = .Cells(RowCounter, 10)
Note = "No corrections."
Case 3.6 To 10.5
Result = .Cells(RowCounter, 11)
Note = "Correction per ISO16032"
Case 0.1 To 3.5
Result = .Cells(RowCounter, 12)
Note = "Correction limit set to 2,2 dB"
Case Else
Note = "Repeat measurement!"
End Select
'Place results on sheet.
.Cells(RowCounter, 7) = IIf(Result >= 0, Result, "")
.Cells(RowCounter, 8) = Note
Next RowCounter
End If
End With
End Sub
My code loops through rows with data on one master-sheet and updates different sheets based on the category of the data on each row. When I run the macro, I can see the information temporarily flash where it should be pasted on the worksheet before disappearing. This does not happen where I have used the same copy/paste command before.
The beggining two loops with WOB and ROP will paste correctly while the custom loop does not. I have also tried making the Select Case into several elseif statements which has the same non-working result.
Sub SortData()
Dim Datasheet As Worksheet
Dim ROPsheet As Worksheet 'Rate of Penetration
Dim Customsheet As Worksheet
Dim WOBsheet As Worksheet 'Weight on Bit
Dim i As Long 'Used as counter to loop through compiled data sheet
Dim j As Long 'Used as counter for each Limiter tested
Dim LastRowCount As Long 'Finds number of rows for ending loop
Dim Limiter As String 'These are WOB, ROP, Custom ect.
Dim DepthCheck As Double 'Checks depth on individual limiter sheet with depth on data sheet
Dim DatetCheck As String 'Checks date on individual limiter sheet with depth on data sheet
Dim Depth As Double 'depth from data sheet
Dim Datet As String 'date from limiter sheet
Dim y As Double 'Used to progress through rows
Set Datasheet = Worksheets("Data")
Set ROPsheet = Worksheets("ROP")
Set Customsheet = Worksheets("Custom")
Set WOBsheet = Worksheets("WOB")
y = 1
i = 1
'_____________________________________Working_Code_Below__________________________________________________________
'Arbitrary Count for testing
For i = 1 To 100
y = y + 1
Limiter = Worksheets("Data").Cells(y, 2).Value
Depth = Worksheets("Data").Cells(y, 5).Value
Datet = Worksheets("Data").Cells(y, 6).Value
'WOB
If Limiter = "WOB" Then
j = 1
LastRowCount = WOBsheet.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Count
For j = 1 To LastRowCount
DepthCheck = Worksheets("WOB").Cells(j + 1, 5).Value
DatetCheck = Worksheets("WOB").Cells(j + 1, 6).Value
If DepthCheck <> Depth Or DatetCheck <> Datet Then
If j = LastRowCount Then
Datasheet.Range(Datasheet.Cells(y, 2), Datasheet.Cells(y, 13)).Copy Sheets("WOB").Cells(j + 1, 2)
GoTo EndLast
End If
Else
GoTo EndLast
End If
Next j
Else
GoTo ROPStart
End If
ROPStart:
If Limiter = "ROP" Then
j = 1
LastRowCount = ROPsheet.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Count
For j = 1 To LastRowCount
DepthCheck = Worksheets("ROP").Cells(j + 1, 5).Value
DatetCheck = Worksheets("ROP").Cells(j + 1, 6).Value
If DepthCheck <> Depth Or DatetCheck <> Datet Then
If j = LastRowCount Then
Datasheet.Range(Datasheet.Cells(y, 2), Datasheet.Cells(y, 13)).Copy Sheets("ROP").Cells(j + 1, 2)
GoTo EndLast
End If
Else
GoTo EndLast
End If
Next j
Else
GoTo CustomStart
End If
CustomStart:
j = 1
LastRowCount = Customsheet.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Count
Select Case Limiter
Case "WOB", "Balling", "RPM", "Vibrations", "Torque", "Buckling", "Differential Pressure", "Flow Rate", "Pump Pressure", "Well Control", "Directional", "Logging", "ROP"
GoTo EndLast
Case Else
For j = 1 To LastRowCount
DepthCheck = Worksheets("Custom").Cells(j + 1, D).Value
DatetCheck = Worksheets("Custom").Cells(j + 1, dt).Value
If DepthCheck <> Depth Or DatetCheck <> Datet Then
If j = LastRowCount Then
Datasheet.Range(Datasheet.Cells(y, 2), Datasheet.Cells(y, 13)).Copy Sheets("Custom").Cells(j + 1, 2)
GoTo EndLast
End If
Else
GoTo EndLast
End If
Next j
End Select
EndLast:
Next i
End Sub
No error messages appear.
PS. This is my first post so sorry if formatting is weird.
Welcome to SO and congratulations on your first post. One of these days I'll be there with you, I'm just looking for the perfect question that's all. Lack of courage has nothing to do with it, really, scout's honor. Pinky promise!
I've tried following your code and struggle quite a bit because of the nonlinear flow. The problem you describe sounds like the data is written and then overwritten. This would typically be caused by a superfluous loop, in your case it may be induced by GoTo.
Touching on the comments about finding the row count; this is a surprisingly nuanced subject with many different answers and the correct one dependent on your circumstances and needs. Most of the time I can use UsedRange, as in Sheet1.UsedRange.Rows.Count; but I predominately work on spreadsheets I maintain and keep things as tight as my knowledge allows at the time. I don't remember how long ago I bookmarked this website but I swear I used it daily for a couple months straight: OZGrid Excel Ranges And of course Chip Pearson is worth a call out CPearson Last Used Cell
Please take this last bit as constructive criticism and have a good laugh. When you try to follow this code and get lost, take a step back, look at your code, and find the same pattern - and stop doing it. Break the habit and break the habit hard. Some people, myself included have a near visceral reaction when trying to debug spaghetti code. Try to write linearly top down. You'll find that you understand your own code better, it's easier to keep track of your thoughts, and transfer those thoughts into code. It's a win, win, win situation. GoTo's are almost entirely unnecessary and really impede the progress of others trying to help; using one here or there can be a handy little shortcut in a 5 line function but are best avoided when your code requires scrolling.
Sub aProcedure()
GoTo T
V:
j = vbCancel
b = "point"
GoTo K
X2:
j = x
b = "before"
GoTo K
A1:
For i = VbMethod To vbCancel
b = DoThingWith(DoThingWith(b, 44), b)
Next
j = j * 3
a = DoThingWith(a, b)
GoTo Z
Z:
b = "times"
GoTo K
U2:
j = j + 1 - x
b = "has"
GoTo K
A2:
MsgBox DoThingWith(a)
Exit Sub
X1:
j = j + 1
b = "made"
GoTo K
T:
a = "this"
GoTo U1
K:
a = DoThingWith(a, b)
DoEvents
Select Case j
Case 0
GoTo A2
Case 1
GoTo U1
Case 2
GoTo U2
Case 3
GoTo W
Case 4
GoTo X1
Case 5
GoTo Y
Case Else
GoTo X2
End Select
W:
j = 2 * (j - 1)
b = "been"
GoTo K
Y:
b = "many"
GoTo A1
U1:
a = Replace(a, Left(a, 1), UCase(Left(a, 1)))
GoTo V
End Sub
Private Function DoThingWith(a, Optional b = 46, Optional c = 32)
If IsNumeric(b) Then
b = CInt(b)
c = CInt(c)
Select Case Asc(Right(a, 1))
Case b
DoThingWith = a & Chr(b - c - 1)
Case Else
DoThingWith = a & Chr(b)
End Select
ElseIf IsNumeric(c) Then
c = CInt(c)
DoThingWith = a & Chr(c) & b
Else
DoThingWith = a & b & c
End If
End Function
The output:
I am attempting to create an Auto-grading test of sorts in Excel.
I have 5 values in Sheet1 that are input by a user in cells E5:E9. These should then be compared against a range of 5 more cells in Sheet2 (also cells E5:E9).
As the user might not always list these entries in the same order that I have in my Sheet2 range, I decided that I should loop through the range for each cell's input.
The next step would be to be able to ignore the value in the range once a match has been found but I need to get this part working correctly. Currently, the values absolutely match. However, I am not getting the correct output.
Sub Q1()
Dim i As Integer
For i = 5 To 9
If (Sheet1.Cells(5, 5) = Sheet2.Cells(i, 5)) And (Sheet1.Cells(6, 5) = Sheet2.Cells(i, 5)) And (Sheet1.Cells(7, 5) = Sheet2.Cells(i, 5)) And (Sheet1.Cells(8, 5) = Sheet2.Cells(i, 5)) And (Sheet1.Cells(9, 5) = Sheet2.Cells(i, 5)) Then
Sheet1.Cells(5, 6) = 1
Exit For
Else
Sheet1.Cells(5, 6) = 0
End If
Next
End Sub
I would expect the output of 1 to Sheet1 cell E6 but I am currently getting 0. Thanks!
Little Complex :)
Sub Q1()
Dim i As Integer
Dim j As Integer
Dim chck(5 To 9) As Boolean
For i = 5 To 9
For j = 5 To 9
If Sheet1.Cells(i, 5) = Sheet2.Cells(j, 5) Then
chck(i) = True
Exit For
Else: chck(i) = False
End If
Next
Next
j = 0
For i = LBound(chck) To UBound(chck)
If chck(i) = True Then j = j + 1
Next
If j = 5 Then
Sheet1.Cells(5, 6) = 1
Else: Sheet1.Cells(5, 6) = 0
End If
End Sub
Does this really need to be VBA? A formula can perform this calculation. Use this in 'Sheet1' cell F5:
=--(SUMPRODUCT(COUNTIF(Sheet2!E5:E9,E5:E9))>0)
If at least one of the values in 'Sheet1'!E5:E9 (the user entered values) exists in your 'Sheet2'!E5:E9 list, the formula will return a 1 else 0 which is the desired result based on your description.
I have a code that searches an excel fill for the word distance, takes the value of the cell next to it, paste it into a new cell, then sums all the cells up. Which works great, but i now need to find a way to only sum ever even row number. Does that make sense?
Sub Distance_Check()
Dim DistanceCheck As String
Dim DistanceNumber As String
Dim DistanceSum As String
Dim DistanceTotal As String
DistanceCheck = MsgBox("Would you like to check the distance?", vbYesNo)
If DistanceCheck = vbYes Then
If IsArray(fname) Then Workbooks.OpenText fname(1)
i = 1
findStr = "Distance"
Set foundCel = Range("A:A").Find(what:=findStr)
If Not foundCel Is Nothing Then
firstAddress = foundCel.Address
Do
Range("J" & i).Value = foundCel.Offset(0, 1).Value
Set foundCel = Range("A:A").FindNext(foundCel)
i = i + 1
Loop While Not foundCel Is Nothing And foundCel.Address <> firstAddress
End If
Set wkbSourceBook = ActiveWorkbook
DistanceNumber = i - 2
DistanceSum = WorksheetFunction.Sum(Range(Cells(2, 15), (Cells(DistanceNumber + 1, 15))))
DistanceTotal = DistanceSum / DistanceNumber
If DistanceNumber = Cells(2, 12) Then
MsgBox ("No error found wihin distance")
Else
MsgBox ("Error found with distance")
End If
Else
End If
Call Save_Data
End Sub
Would the way youd go about this be using a for loop on the
cells(DistanceNumber(j,+1)
Where j = 0,
j = j +2 ,
Until j > DistanceNumber,
Would that work? If so how would you go about it?
Thanks
A quick way to step through a loop in the desired increments is to use the Mod operator which divides two numbers and returns any remainder (e.g. 7 mod 2 = 1, as two sixes fit into seven, leaving one).
You can use the row property of the range you identify with the Find method, and since you want to jump by two the modulo should be zero:
If foundcel.Row Mod 2 = 0 Then Range("J" & i).value = foundcel.Offset(0, 1).Value
That said, there is a 'built in' way to step through a loop if using a For loop like this
For x = 2 to 10 Step 2
' Do stuff
Next x
You can also use this method to step backwards, e.g.
For x = 100 to 0 Step -10
' Do stuff backwards!
Next x
I keep getting a "compile error: next without For" when I try to run this code. However, after checking everything over multiple times, I do not see how it does not recognize their presences. This is my first VBA code, so any help would be greatly appreciated.
Sub Naming()
'
' Naming Macro
' Assigns a category name in a cell based on values in a cell one column over
'
Dim number As Double
For i = 9 To 200
number = Cells(i, 3).Value
If number = 0 Then
GoTo Line1
Else
If number <= 199999 And number > 0 Then
Cells(i, 2) = "EP-GEARING"
Else
If number <= 399999 And number > 199999 Then
Cells(i, 2) = "DRIVES"
Else
If number <= 499999 And number > 399999 Then
Cells(i, 2) = "FLOW"
Else
If number <= 599999 And number > 499999 Then
Cells(i, 2) = "SPARES"
Else
If number <= 699999 And number > 599999 Then
Cells(i, 2) = "REPAIR"
Else
If number <= 799999 And number > 699999 Then
Cells(i, 2) = "FS"
Else
If number <= 899999 Then
Cells(i, 2) = "GC-GEARING"
Else
GoTo Line1
Line1:
End If
Next i
End Sub
ElseIf is one word in VB.
If number = 0 Then
'Do nothing
ElseIf number <= 199999 And number > 0 Then
Cells(i, 2) = "EP-GEARING"
ElseIf number <= 399999 And number > 199999 Then
...
Else
'Do nothing
End If
However, Select Case would fit better here:
Select Case number
Case 0
'Do nothing
Case 1 To 199999
Cells(i, 2) = "EP-GEARING"
Case 200000 To 399999
...
Case Else
'Do nothing
End Select
Your code should look like this:
Sub Naming()
'
' Naming Macro
' Assigns a category name in a cell based on values in a cell one column over
'
Dim number As Double
For i = 9 To 200
number = Cells(i, 3).Value
If number <= 199999 And number > 0 Then
Cells(i, 2) = "EP-GEARING"
ElseIf number <= 399999 And number > 199999 Then
Cells(i, 2) = "DRIVES"
ElseIf number <= 499999 And number > 399999 Then
Cells(i, 2) = "FLOW"
ElseIf number <= 599999 And number > 499999 Then
Cells(i, 2) = "SPARES"
ElseIf number <= 699999 And number > 599999 Then
Cells(i, 2) = "REPAIR"
ElseIf number <= 799999 And number > 699999 Then
Cells(i, 2) = "FS"
ElseIf number <= 899999 Then
Cells(i, 2) = "GC-GEARING"
End If
Next i
End Sub
The problem with your code as originally written is that, regardless of the Else clauses, the compiler still expects an End If for every If, and is getting confused because they are not there. The single keyword ElseIf only requires one End If statement at the end.
Goto's are seldom advisable. 99 percent of the time, there's a better and cleaner way to write it, without using a Goto.
The other answers indicate how you could fix your If statement so that VBA recognizes your For and Next pair up.
Now, personally, I would suggest using Select Case as GSerg indicated, if your loop were necessary.
But here is probably what I would do. In Cell B9 place the following formula: =IF(C9=0,"",IF(C9<=199999,"EP-GEARING",IF(C9<=399999,"DRIVES",IF(C9<=499999,"FLOW",IF(C9<=599999,"SPARES",IF(C9<=699999,"REPAIR",IF(C9<=799999,"FS",IF(C9<=899999,"GC-GEARING","")))))))) then copy it down where you need it.
Or if you want to do it with code you could replace your whole sub with no looping I could have written this as a 1 liner, but I wanted it to be legible:
Sub Naming()
'
' Naming Macro
' Assigns a category name in a cell based on values in a cell one column over
Dim theRange As Range
Set theRange = Range(Cells(9, 2), Cells(200, 2))
theRange.Value = "=IF(RC[1]=0,""""," & _
"IF(RC[1]<=199999,""EP-GEARING""," & _
"IF(RC[1]<=399999,""DRIVES""," & _
"IF(RC[1]<=499999,""FLOW""," & _
"IF(RC[1]<=599999,""SPARES""," & _
"IF(RC[1]<=699999,""REPAIR""," & _
"IF(RC[1]<=799999,""FS""," & _
"IF(RC[1]<=899999,""GC-GEARING"",""""))))))))"
'Optional if you want only the values without the formula, uncomment next line
'theRange.Value = theRange.Value
Set theRange = Nothing
End Sub
It is generally faster and cleaner to solve things like this using Excel formulas rather than writing out the logic in VBA and looping through cells.