parscon
08-12-2013, 03:29 AM
I have a VBA code that will search a word and if find the word will copy them to ToCopy sheet and after that in column F will use this formula
Range("F" & x).FormulaR1C1 = "=ROUND(RC[-2]/4*3-RC[-1],)"
=ROUND(D1/4*3-E1,)
Now , I need load this formula from another sheet that mean I need to change 4*3 always with other numbers and I do not want my user edit VBA code .
Hope you will understand what I need .
Thank you very much.
Sub START()
Dim vSearch As Variant
Dim i As Long
Dim k As Long
Dim LastRow As Long
Dim x As Long
Dim lRowToCopy As Long
vSearch = "CENTER-1"
i = 1
Do Until WorksheetFunction.CountA(Sheets("All").Rows(i)) = 0
On Error Resume Next
lRowToCopy = 0
lRowToCopy = Sheets("All").Rows(i).Find(What:=vSearch, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows).Row
On Error GoTo 0
If lRowToCopy > 0 Then
For k = 1 To Sheets("ToCopy").Rows.Count
If WorksheetFunction.CountA(Sheets("ToCopy").Rows(k)) = 0 Then
Sheets("All").Rows(i).Copy
Sheets("ToCopy").Select
Rows(k).Select
ActiveSheet.Paste
Exit For
End If
Next k
End If
i = i + 1
Loop
LastRow = Range("E65536").End(xlUp).Row
For x = LastRow To 1 Step -1
If Application.WorksheetFunction.CountIf(Range("F1:F" & x), Range("F" & x).Text) > 0 Then
Range("F" & x).FormulaR1C1 = "=ROUND(RC[-2]/4*3-RC[-1],)"
End If
Next x
End Sub
Range("F" & x).FormulaR1C1 = "=ROUND(RC[-2]/4*3-RC[-1],)"
=ROUND(D1/4*3-E1,)
Now , I need load this formula from another sheet that mean I need to change 4*3 always with other numbers and I do not want my user edit VBA code .
Hope you will understand what I need .
Thank you very much.
Sub START()
Dim vSearch As Variant
Dim i As Long
Dim k As Long
Dim LastRow As Long
Dim x As Long
Dim lRowToCopy As Long
vSearch = "CENTER-1"
i = 1
Do Until WorksheetFunction.CountA(Sheets("All").Rows(i)) = 0
On Error Resume Next
lRowToCopy = 0
lRowToCopy = Sheets("All").Rows(i).Find(What:=vSearch, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows).Row
On Error GoTo 0
If lRowToCopy > 0 Then
For k = 1 To Sheets("ToCopy").Rows.Count
If WorksheetFunction.CountA(Sheets("ToCopy").Rows(k)) = 0 Then
Sheets("All").Rows(i).Copy
Sheets("ToCopy").Select
Rows(k).Select
ActiveSheet.Paste
Exit For
End If
Next k
End If
i = i + 1
Loop
LastRow = Range("E65536").End(xlUp).Row
For x = LastRow To 1 Step -1
If Application.WorksheetFunction.CountIf(Range("F1:F" & x), Range("F" & x).Text) > 0 Then
Range("F" & x).FormulaR1C1 = "=ROUND(RC[-2]/4*3-RC[-1],)"
End If
Next x
End Sub