Yeah i ve done it! But i need one thing -if activecell in column b - paste =Page1!E2
Sub FOT()
Dim rgb
ActiveCell.Offset(0, -1).Select
With ActiveCell
Set Rng = .EntireRow.Cells(2).Resize(1, .Column - 1)
.Offset(0, 1).Select
rgb = Evaluate("=SUM(" & Rng.Address & ")")
End With
If rgb < 1500001 Then
ActiveCell.Formula = "=Page1!E2"
Else
ActiveCell.Formula = "=Page1!F2"
End If
ActiveCell.Value = ActiveCell.Value
End Sub
Sub FOT()
Dim rgb
If ActiveCell.Column() = 2 Then
ActiveCell.Formula = "=Page1!E2"
Exit Sub
End If
ActiveCell.Offset(0, -1).Select
With ActiveCell
Set Rng = .EntireRow.Cells(2).Resize(1, .Column - 1)
.Offset(0, 1).Select
rgb = Evaluate("=SUM(" & Rng.Address & ")")
End With
If rgb < 1500001 Then
ActiveCell.Formula = "=Page1!E2"
Else
ActiveCell.Formula = "=Page1!F2"
End If
ActiveCell.Value = ActiveCell.Value
End Sub
Related
I am trying to convert a sub procedure to a function. This sub generate number based on some conditions. It's working as expected but when I try to convert it as a function, it only generate "0".
Can anyone please help? It will be great appreciated!
Here is my sub named "GenerateNumber"
Public Sub GenerateNumber()
Dim evenRange As Range
Dim oddRange As Range
Dim i As Integer
Set evenRange = Range("A2:Z2,A4:Z4,A6:Z6,A8:Z8,A10:Z10,A12:Z12,A14:Z14,A16:Z16,A18:Z18 ")
Set oddRange = Range("A1:Z1,A3:Z3,A5:Z5,A7:Z7,A9:Z9,A11:Z11,A13:Z13,A15:Z15,A17:Z17,A19:Z19")
If Not Intersect(Activecell, evenRange) Is Nothing Then
If Activecell.Interior.Color = Activecell.Offset(0, -1).Interior.Color Then
Activecell.Value = Activecell.Offset(0, -1).Value + 1
For i = 1 To Selection.Cells.Count - 1
Activecell.Offset(0, i).Value = Activecell.Value + i
Next i
Else
Activecell.Value = 1
For i = 1 To Selection.Cells.Count - 1
Activecell.Offset(0, i).Value = Activecell.Value + i
Next i
End If
'MsgBox "Active Cell In Even Range!"
Else
' MsgBox "Active Cell In Odd Range!"
If Activecell.Interior.Color = Activecell.Offset(0, 1).Interior.Color Then
Activecell.Value = Activecell.Offset(0, 1).Value + 1
For i = 1 To Selection.Cells.Count - 1
Activecell.Offset(0, -i).Value = Activecell.Value + i
Next i
Else
Activecell.Value = 1
For i = 1 To Selection.Cells.Count - 1
Activecell.Offset(0, -i).Value = Activecell.Value + i
Next i
End If
End If
End Sub
And my function code like this,
Public Function GenNumber() As Variant
Dim evenRange As Range
Dim oddRange As Range
Dim rng As Range
Dim i As Integer
Set evenRange = Range("A2:Z2,A4:Z4,A6:Z6,A8:Z8,A10:Z10,A12:Z12,A14:Z14,A16:Z16,A18:Z18 ")
Set oddRange = Range("A1:Z1,A3:Z3,A5:Z5,A7:Z7,A9:Z9,A11:Z11,A13:Z13,A15:Z15,A17:Z17,A19:Z19")
If Not Intersect(Activecell, evenRange) Is Nothing Then
If Activecell.Interior.Color = Activecell.Offset(0, -1).Interior.Color Then
Activecell.Value = Activecell.Offset(0, -1).Value + 1
For i = 1 To Selection.Cells.Count - 1
Activecell.Offset(0, i).Value = Activecell.Value + i
Next i
Else
Activecell.Value = 1
For i = 1 To Selection.Cells.Count - 1
Activecell.Offset(0, i).Value = Activecell.Value + i
Next i
End If
'MsgBox "Active Cell In Even Range!"
Else
' MsgBox "Active Cell In Odd Range!"
If Activecell.Interior.Color = Activecell.Offset(0, 1).Interior.Color Then
Activecell.Value = Activecell.Offset(0, 1).Value + 1
For i = 1 To Selection.Cells.Count - 1
Activecell.Offset(0, -i).Value = Activecell.Value + i
Next i
Else
Activecell.Value = 1
For i = 1 To Selection.Cells.Count - 1
Activecell.Offset(0, -i).Value = Activecell.Value + i
Next i
End If
End If
GenNumber = Activecell.Value
End Function
Can anyone say where is the wrong and how to solve it.
Thank you.
I was trying to do a countif in a column B named First Name that has different names in it but the results is returning 0.
Here is my code:
Public Sub counting()
Dim lastcell As String
Range("B2").Select
Selection.End(xlDown).Select
lastcell = ActiveCell.Address
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = "=countif(B2:" + lastcell + ", John)"
End Sub
If I check the formula written in the active cell it is:
=COUNTIF(B2:$B$16, John)
Please help.
I tried changing the line from
ActiveCell.Value = "=countif(B2:" + lastcell + ", John)"
to
ActiveCell.Value = "=countif(B2:" + lastcell + ", "John")" still not working.
Public Sub counting()
With Range("B2").End(xlDown)
.Offset(1, 0).Formula = "=COUNTIF(B2:" & .Address(False, False) & ", ""John"")"
End with
End Sub
Try,
ActiveCell.formula = "=countif(B2:" & lastcell & chr(44) & chr(34) &"John" &chr(34) & ")"
Image below shows an Excel list I have. Columns A-C is the contents I have. Columns D and E is the result I'm looking for. I've manually entered it to show the result.
Currently my code looks like this:
Option Explicit
Sub New_SKU()
Dim wb As Workbook
Dim ws As Worksheet
'figure out how far down data goes
Dim endrow As Long
Dim currentrow As Long
Dim basename
Set wb = ThisWorkbook
Set ws = wb.Sheets("Blad1")
With ws
endrow = .Cells(.Rows.Count, "A").End(xlUp).Row
'always start in the correct column
.Cells(.Cells(1, "B").End(xlDown).Row, "B").Activate
'loop through all data
Do While ActiveCell.Row < endrow
'loop through empty cells and set formula if cell isn't empty
Do While ActiveCell.Row <= endrow
'if next cell isn't empty, isn't past the end of the list, go to outer loop
If ActiveCell.Formula <> "" And ActiveCell.Offset(1, 0).Formula = "" And ActiveCell.Row <= endrow Then
basename = Selection.Address
ActiveCell.Offset(0, 2).Formula = "=CONCATENATE(" & basename & ",""-""," & "C" & Selection.Row & ")"
' ActiveCell.Offset(0, 3).Formula = "=" & basename & ""
ActiveCell.Offset(1, 0).Activate
' If ActiveCell.Formula = "" And ActiveCell.Offset(0, 1).Formula <> "" And ActiveCell.Row <= endrow Then
' ActiveCell.Offset(0, 2).Formula = "=CONCATENATE(" & basename & ",""-""," & "C" & Selection.Row & ")"
' ActiveCell.Offset(0, 3).Formula = "=" & basename & ""
' ActiveCell.Offset(1, 0).Activate
' If ActiveCell.Formula = "" And ActiveCell.Offset(0, 1).Formula <> "" And ActiveCell.Row <= endrow Then
' ActiveCell.Offset(0, 2).Formula = "=CONCATENATE(" & basename & ",""-""," & "C" & Selection.Row & ")"
' ActiveCell.Offset(0, 3).Formula = "=" & basename & ""
' ActiveCell.Offset(1, 0).Activate
' If ActiveCell.Formula = "" And ActiveCell.Offset(0, 1).Formula <> "" And ActiveCell.Row <= endrow Then
' ActiveCell.Offset(0, 2).Formula = "=CONCATENATE(" & basename & ",""-""," & "C" & Selection.Row & ")"
' ActiveCell.Offset(0, 3).Formula = "=" & basename & ""
' ActiveCell.Offset(1, 0).Activate
' If ActiveCell.Formula = "" And ActiveCell.Offset(0, 1).Formula <> "" And ActiveCell.Row <= endrow Then
' ActiveCell.Offset(0, 2).Formula = "=CONCATENATE(" & basename & ",""-""," & "C" & Selection.Row & ")"
' ActiveCell.Offset(0, 3).Formula = "=" & basename & ""
' ActiveCell.Offset(1, 0).Activate
' If ActiveCell.Formula = "" And ActiveCell.Offset(0, 1).Formula <> "" And ActiveCell.Row <= endrow Then
' ActiveCell.Offset(0, 2).Formula = "=CONCATENATE(" & basename & ",""-""," & "C" & Selection.Row & ")"
' ActiveCell.Offset(0, 3).Formula = "=" & basename & ""
' ActiveCell.Offset(1, 0).Activate
Else
Exit Do
End If
' End If
' End If
' End If
' End If
' End If
Loop
Loop
End With
End Sub
I am reusing code from a similar problem I received help with earlier.
My first problem:
If uncomment the If-statements, when I start the script Excel goes blank (white) and stalls immediatly.
Running the script in its current state (If-satements commented out), I can see that I get the correct result in cell D2 and then cell B3 is selected (keep in mind that there are no results in column D or E), and then the screen goes blank and Excel stalls. I do not get any result in column E.
Since there are variation in sizes (column C), it can vary from 2-3 to 5-6.
I cannot figure out why I won't receive a result in E-column and why it stalls and goes white.
Any ideas?
As per comment above, here is a different approach
Sub x()
Dim r As Long
Columns(2).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=r[-1]c"
For r = 2 To Range("A" & Rows.Count).End(xlUp).Row
Cells(r, 4).Value = Cells(r, 2).Value & "-" & Cells(r, 3).Value
Cells(r, 5).Value = Cells(r, 2).Value
Next r
Columns(2).SpecialCells(xlCellTypeFormulas).ClearContents
End Sub
If you're okay with a non-VBA answer, you can paste this formula in D2 and copy down:
=IF(B2="",LEFT(D1,FIND("-",D1)-1)&"-"&C2,B2&"-"&C2)
I'm trying to copy cells (strings) from one sheet ('Summary Document' all on row 4) to a table in the second sheet ('Worker 1', starting at B10). I believe I have defined all elements correctly. When I run the first time, it works. however, it gives me a 1004 error on the second run. I'm pretty sure it is my if/then statement that looks for the next empty line, but not sure what the issue is.
Dim FileName As String, FileNumber As String, RecordingPeriod As String, RecordingType As String, Auditor As String, ReviewDate As String`
Dim A1 As String, A2 As String, A3 As String, A4 As String, A5 As String, A6 As String
Worksheets("Summary Document").Select
FileName = Range("C4")
FileNumber = Range("D4")
RecordingPeriod = Range("E4")
RecordingType = Range("F4")
Auditor = Range("G4")
ReviewDate = Range("H4")
A1 = Range("J4")
A2 = Range("K4")
A3 = Range("L4")
A4 = Range("M4")
A5 = Range("N4")
A6 = Range("O4")
Worksheets("Worker 1").Select
Worksheets("Worker 1").Range("B9").Select
If Worksheets("Worker 1").Range("B9").Offset(1, 0) <> "" Then
Worksheets("Worker 1").Range("B9").End(x1Down).Select
End If
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = FileName
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = FileNumber
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = RecordingPeriod
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = RecordingType
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Auditor
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = ReviewDate
ActiveCell.Offset(0, 2).Select
ActiveCell.Value = A1
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = A2
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = A3
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = A4
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = A5
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = A6
End Sub
Also in Addition to the comment above, the code can be simplfied greatly:
Sub hhhhh()
Dim ows as Worksheet
Dim tws As Worksheet
Dim rw as long
Set ows = Worksheets("Summary Document")
Set tws = Worksheets("Worker 1")
If tws.Range("B10") <> "" Then
rw = 10
Else
rw = tws.Range("B9").End(xlDown).Row + 1
End If
tws.Range("B" & rw & ":G" & rw).Value = ows.Range("C4:H4").Value
tws.Range("I" & rw & ":N" & rw).Value = ows.Range("J4:O4").Value
End Sub
One should always avoid using the .Select when possible. See This Link for great options.
I am attempting to select a range of cells. I have done this before but am having trouble with the syntax.
Sub ChgDateX()
Range("A41").Select
Do
If ActiveCell.Value = "Last Updated" Then
mydate = ActiveCell.Offset(-40, 0).Value
'Cells(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 9)).Select
ActiveCell.Offset(0, 1).Value = mydate
ActiveCell.Offset(0, 2).Value = mydate
ActiveCell.Offset(0, 3).Value = mydate
ActiveCell.Offset(0, 4).Value = mydate
ActiveCell.Offset(0, 5).Value = mydate
ActiveCell.Offset(0, 6).Value = mydate
ActiveCell.Offset(0, 7).Value = mydate
ActiveCell.Offset(0, 8).Value = mydate
ActiveCell.Offset(0, 9).Value = mydate
ActiveCell.EntireRow.Select
Selection.NumberFormat = "m/d/yyyy"
ActiveCell.Offset(1, 0).Select
Else: ActiveCell.Offset(1, 0).Select
End If
Loop Until ActiveCell.Value = "" & ActiveCell.Offset(-3, 0).Value = ""
End Sub
I am trying to get away from the individual offset = mydate type coding.
Couple of things:
This code:
Loop Until ActiveCell.Value = "" & ActiveCell.Offset(-3, 0).Value = ""
Doesn't work as expected because the correct operator you're looking for is And and not &
You don't have to "Select" anything. You can just put a reference to a cell in a variable (see my code).
Also, since you are always moving down to the next cell in the loop, you can put that outside of the IF statement.
Based on your code I think you're looking for something like this:
Option Explicit
Sub test()
Dim r As Range
Dim myDate As Date
Set r = Range("A41")
Do
If (r.Value = "Last Updated") Then
myDate = r.Offset(-40, 0).Value
With Range(r.Offset(0, 1), r.Offset(0, 9))
.Value = myDate
.NumberFormat = "m/d/yyyy"
End With
End If
Set r = r.Offset(1, 0)
Loop Until r.Value = vbNullString And r.Offset(-3, 0).Value = ""
End Sub
Try this:
ActiveCell.Range("B1:J1").Value = MyDate
How about this ... with 1 note. I wouldn't advise the looping like this. Perhaps you can filter on Column A <> "" or something, then just loop through the visible cells? Hard to say without knowing what you are doing.
Option Explicit
Sub ChgDateX()
Range("A41").Select
Do
If ActiveCell.Value = "Last Updated" Then
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 9)).Value = ActiveCell.Offset(-40, 0).Value
ActiveCell.EntireRow.NumberFormat = "m/d/yyyy"
End If
ActiveCell.Offset(1).Select
Loop Until ActiveCell.Value = "" & ActiveCell.Offset(-3, 0).Value = ""
End Sub