Excel vba error 1004 - insert a formula - vba

i'm trying to execute these code in my excel sheet
ActiveCell.Offset(0, 3).Formula = "=if(SUM(N" & i + 2 & ":N" & i + 5 & ")>0;MEDIAN(N" & i + 2 & ":N" & i + 5 & ");0)"
and i'm get an #1004 error with no more informations. Can anybody eyplain my failure?
I hav some others formulars insert in the same way...thx
EDIT:
My Tables look like that
This should be a projectmanagement tool - Breitband Delphi Method ;)
So my code goes through all the rows and check in which column the descripton is (level 1,2,3,4).
Next the code is adding the rows 8-12 for example.. here i can enter some informations for the project... and now my script should add the formula at column k-n.
My code is not very nice (as my english :) ) - it is just a prototype..
This is my Loop
i = 5
canSkip = False
Do
' fist first the level
If Not IsEmpty(Range("B" & i).Value) Then
level = 1
If Not IsEmpty(Range("D" & i + 1)) Then
' ye we can - so skip this loop
canSkip = True
End If
ElseIf Not IsEmpty(Range("D" & i).Value) Then
level = 2
If Not IsEmpty(Range("F" & i + 1)) Then
' ye we can - so skip this loop
canSkip = True
End If
ElseIf Not IsEmpty(Range("F" & i).Value) Then
level = 3
If Not IsEmpty(Range("H" & i + 1)) Then
' ye we can - so skip this loop
canSkip = True
End If
ElseIf Not IsEmpty(Range("H" & i).Value) Then
level = 4
canSkip = False
End If
If canSkip = True Then
i = i + 1
Else
' First insert some... and bang it to a group
' Insert Formula
Range("K" & i).Activate
ActiveCell.Formula = "=min(L" & i + 2 & ":L" & i + 5 & ")"
ActiveCell.Offset(0, 1).Formula = "=max(L" & i + 2 & ":L" & i + 5 & ")"
'Range("T1").FormulaLocal = insertMedianFormula
'ActiveCell.Offset(0, 3).Formula = "=WENN(SUMME(N" & i + 2 & ":N" & i + 5 & ")>0;MITTELWERT(N" & i + 2 & ":N" & i + 5 & ");0)"
Range("A" & i + 1).Activate
For x = 1 To 5
ActiveCell.EntireRow.Insert
If x = 5 Then
If level = 1 Then
ActiveCell.Offset(0, 1).Value = "Experte"
ActiveCell.Offset(0, 2).Value = "Aufw."
ActiveCell.Offset(0, 3).Value = "Bemerkung"
ElseIf level = 2 Then
ActiveCell.Offset(0, 3).Value = "Experte"
ActiveCell.Offset(0, 4).Value = "Aufw."
ActiveCell.Offset(0, 5).Value = "Bemerkung"
ElseIf level = 3 Then
ActiveCell.Offset(0, 5).Value = "Experte"
ActiveCell.Offset(0, 6).Value = "Aufw."
ActiveCell.Offset(0, 7).Value = "Bemerkung"
ElseIf level = 4 Then
ActiveCell.Offset(0, 7).Value = "Experte"
ActiveCell.Offset(0, 8).Value = "Aufw."
ActiveCell.Offset(0, 9).Value = "Bemerkung"
End If
' now just bang it to a group
ActiveCell.Resize(5, 10).Rows.Group
End If
Next x
i = i + 6
End If
' are we finshed?
If i > lastUsedRow Then
Exit Do
End If
canSkip = False
Loop

Original formula (MS standard) uses "," instead of ";"
ActiveCell.Offset(0, 3).Formula = "=IF(SUM(N" & i + 2 & ":N" & i + 5 & ")>0,MEDIAN(N" & i + 2 & ":N" & i + 5 & "),0)"
or use:
ActiveCell.Offset(0, 3).FormulaLocal = "=IF(SUM(N" & i + 2 & ":N" & i + 5 & ")>0;MEDIAN(N" & i + 2 & ":N" & i + 5 & ");0)"
Please, refer this:
Formula
FormulaLocal
[EDIT]
First of all...
IsEmpty indicates whether a variable (of variant) has been initialized. So, if you want to check if cell is empty (does not contains any value), use:
Range("B" & i)<>""
Second of all..
Your code has no context. What it means? Using ActiveCell or Range("") or Cell() depends on what workbook (and its sheet) is actually in usage!
You should use code in context:
With ThisWorkbook.Worksheets("SheetName")
.Range("A1").Offset(0,i).Formula = "='Hello Kitty'"
.Cell(2,i) = "123.45"
End With
Third of all...
Review and debug you code and start again using above tips ;)

Related

Excel VBA To Concatenate

from some googling I found this function that will concatenate the data in columns A, B & C based off the value in column D. This code does not work for me for some reason. My data looks like such
Bob Jason 0123456789 Tim
Jim Jason 0123456789 Tim
Fred Jason 0123456789 Tim
Columns, A and B concat fine, but column C concats to
12,345,678,901,234,500,000,000,000,000
How would the VBA be altered so that the code will concatenate properly?
Sub Concat()
Dim x, i As Long, ii As Long
With Cells(1).CurrentRegion
x = .Columns("d").Offset(1).Address
x = Filter(Evaluate("transpose(if(countif(offset(" & x & ",,,row(1:" & .Rows.Count & "))," & x & ")=1," & x & "))"), False, 0)
For i = 0 To UBound(x)
For ii = 1 To 3
Cells(i + 2, ii + 5).Value = Join(Filter(Evaluate("transpose(if(" & .Columns(4).Address & "=""" & _
x(i) & """," & .Columns(ii).Address & "))"), False, 0), ",")
Next
Cells(i + 2, ii + 5).Value = x(i)
Next
End With
End Sub
You need to set the destination cells to a Text format:
Sub Concat()
Dim x, i As Long, ii As Long
With Cells(1).CurrentRegion
x = .Columns("d").Offset(1).Address
x = Filter(Evaluate("transpose(if(countif(offset(" & x & ",,,row(1:" & .Rows.Count & "))," & x & ")=1," & x & "))"), False, 0)
For i = 0 To UBound(x)
For ii = 1 To 3
Cells(i + 2, ii + 5).NumberFormat = "#"
Cells(i + 2, ii + 5).Value = Join(Filter(Evaluate("transpose(if(" & .Columns(4).Address & "=""" & _
x(i) & """," & .Columns(ii).Address & "))"), False, 0), ",")
Next
Cells(i + 2, ii + 5).NumberFormat = "#"
Cells(i + 2, ii + 5).Value = x(i)
Next
End With
End Sub

Trying to shift rows down to add spaces between dates in Excel VBA

DateSort = Cells(Cells.Rows.Count, "B").End(xlUp).Row
For currentDate = 2 To DateSort
If Range("B" & currentDate) <> Range("B" & currentDate + 1) Then
currentDate = currentDate + 1
myRange = "A" & currentDate & ":" & "Q" & DateSort
Range(myRange).Select
Selection.Copy
Selection.Clear
myNewRange = "A" & currentDate + 1
Range(myRange).PasteSpecial
Selection.PasteSpecial
End If
Next
I have dates in column "B" of my worksheet. I would like to put a blank row between each group of dates. (They are already sorted)
Currently, my code will check for a new date, select the rest of the dates, copy, and clear the data but will fail when it gets to pasting it into the new range.
I tried modifying your logic to make it work, but even now there is an error because your code is not well written. If there are many different dates the last couple of dates will not have spacing.
datesort = Cells(Cells.Rows.Count, "B").End(xlUp).Row
For currentDate = 2 To datesort
If Range("B" & currentDate) <> Range("B" & currentDate + 1) Then
currentDate = currentDate + 1
myRange = "A" & currentDate & ":" & "Q" & datesort
Range(myRange).Select
Selection.Copy
'Selection.Clear
myNewRange = "A" & currentDate + 1
Range(myNewRange).PasteSpecial
Range("B" & currentDate).Clear
'Selection.PasteSpecial
datesort = datesort + 1
End If
Next
Here is another version of the code with major modification, but it works perfectly
datesort = Cells(Cells.Rows.Count, "B").End(xlUp).Row
For currentdate = 2 To datesort * 2
If Range("B" & currentdate) <> Range("B" & currentdate + 1) Then
Range(Range("B" & currentdate + 1), Range("B" & currentdate + 1).End(xlDown)).Select
If Selection.Cells.Count < 20000 Then
currentdate = currentdate + 1
Selection.Copy
Selection.Offset(1, 0).Select
Selection.PasteSpecial
Range("B" & currentdate).Clear
End If
End If
Next

Compare cells to delete rows, value is true but not deleting rows

I'm trying to compare 2 cells and if its true that row will be deleted, i tried using msgbox to return the value and it shows its true, but row is not deleting.
The first cell is derived using formula in 1 sheet and the other is just numbers, does that make a difference?
Dim r, s, i, t As Long
Dim com, cc, bl, acc As Long
Dim rDB, rInput As Range
Dim shDB, shInput As Worksheet
Set shDB = ActiveWorkbook.Sheets("Database")
Set rDB = shDB.Range("A1", "T1000")
Set shInput = ActiveWorkbook.Sheets("Data Input")
Set rInput = shInput.Range("A1", "R1000")
r = 2
Do While Len(shDB.Cells(r, 1).Formula) > 0
com = shInput.Cells(7, 5).Value
cc = shInput.Cells(5, 5).Value
bl = shInput.Cells(9, 5).Value
acc = shInput.Cells(5, 10).Value
MsgBox (com & " " & shDB.Cells(r, 1).Value & " " & cc & " " & rDB.Cells(r, 2).Value & " " & rDB.Cells(r, 3).Value & " " & bl & " " & rDB.Cells(r, 4).Value & " " & acc)
If shDB.Cells(r, 1).Value = com And rDB.Cells(r, 2).Value = cc And rDB.Cells(r, 3).Value = bl And rDB.Cells(r, 4).Value = acc Then
shDB.Rows(r).EntireRow.Delete
MsgBox ("deleting rows")
Else
r = r + 1
End If
Loop
When deleting alway go from the last index to the first. This applies to listboxes, comboboxes, ranges, ...etc.
If you delete from first to last then you will skip every other row

Ignore string if empty in concatenation formula

I have a formula which concatenates strings in different columns. It works great when there is data in each of the columns but if one column is blank I get an error "invalid procedure call or argument" for the string formed by the empty column. Is there a clause i can add into my code to ignore the string if it is empty?
Sub Concatenation_for_the_nation()
'Range("H2").End(xlDown).Select
Cells(rows.Count, "H").End(xlUp).Select
For i = 1 To ActiveCell.Row
Range("H" & i).Select
StrStrONE = StrStrONE & "" & Selection
Next i
Cells(1, 1).Select
'Range("I2").End(xlDown).Select
Cells(rows.Count, "I").End(xlUp).Select
For j = 1 To ActiveCell.Row
Range("I" & j).Select
StrStrTWO = StrStrTWO & "" & Selection
Next j
Cells(1, 1).Select
'Range("J2").End(xlDown).Select
Cells(rows.Count, "J").End(xlUp).Select
For k = 1 To ActiveCell.Row
Range("J" & k).Select
StrStrTHREE = StrStrTHREE & "" & Selection
Next k
Cells(1, 1).Select
'Range("K2").End(xlDown).Select
Cells(rows.Count, "K").End(xlUp).Select
For l = 1 To ActiveCell.Row
Range("K" & l).Select
StrStrFOUR = StrStrFOUR & "" & Selection
Next l
Cells(1, 1).Select
StrStrONE = Trim(StrStrONE)
StrStrTWO = Trim(StrStrTWO)
StrStrTHREE = Trim(StrStrTHREE)
StrStrTHREE = Left(StrStrTHREE, Len(StrStrTHREE) - 3)
StrStrFOUR = Trim(StrStrFOUR)
StrStrFOUR = Left(StrStrFOUR, Len(StrStrFOUR) - 3)
Cells(14, 7) = "(ISAV(" & StrStrONE & " " & StrStrTWO & " " & StrStrTHREE & ")=1 OR (" & StrStrFOUR & ")=1)=1"
Cells(14, 7).Select
End Sub
You can check if the columns are not empty by using ISBLANK() function
As user2471313 said used ISBLANK() function or I would add something like this for checking the string:
If StrStrONE<>"" and StrStrTWO<>"" and StrStrTHREE<>"" and StrStrFOUR<>"" then
StrStrONE = Trim(StrStrONE)
''''your code until end
End if

Need to compare 2 excel sheets and create report

I have 2 Excel sheets, I need to take 1 value in Sheet 1, look for it in Sheet 2. If I find it, then I need to make sure that some other values are matching. If yes, I copy the sheet 1 row in a "match" tab.
If not, I copy the row in "mismatch" tab and I need to insert a message that says which value didn't match.
I cannot make it work right now. I think I'm not exiting the loop in the right place. Here is my code. If anybody could help, I would appreciate.
Sub compareAndCopy()
Dim LastRowISINGB As Integer
Dim LastRowISINNR As Integer
Dim lastRowM As Integer
Dim lastRowN As Integer
Dim foundTrue As Boolean
Dim ErrorMsg As String
' stop screen from updating to speed things up
Application.ScreenUpdating = False
'Find the last row for column F and Column B from Sheet 1 and Sheet 2
LastRowISINGB = Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, "f").End(xlUp).row
LastRowISINNR = Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, "b").End(xlUp).row
'fIND THE LAST ROW OF MATCH AND MISMATCH TAB
lastRowM = Sheets("mismatch").Cells(Sheets("mismatch").Rows.Count, "f").End(xlUp).row + 1
lastRowN = Sheets("match").Cells(Sheets("match").Rows.Count, "f").End(xlUp).row + 1
'ISIN MATCH FIRST
For I = 2 To LastRowISINGB
For J = LastRowISINNR To 2 Step -1
If Sheets("Sheet1").Cells(I, 6).Value = Sheets("Sheet2").Cells(J, 2).Value And _
Worksheets("Sheet1").Range("B" & I).Value = "Y" And _
Worksheets("Sheet2").Range("Z" & J).Value = "" And _
(Worksheets("Sheet1").Range("c" & I).Value = Worksheets("Sheet2").Range("AF" & J).Value Or _
Worksheets("Sheet1").Range("K" & I).Value = Worksheets("Sheet2").Range("K" & J).Value Or _
Worksheets("Sheet1").Range("N" & I).Value = Worksheets("Sheet2").Range("L" & J).Value) Then
Sheets("Sheet1").Rows(I).Copy Destination:=Sheets("match").Rows(lastRowN)
lastRowN = lastRowN + 1
Exit For
ElseIf Sheets("Sheet1").Cells(I, 6).Value = Sheets("Sheet2").Cells(J, 2).Value And _
Worksheets("Sheet1").Range("B" & I).Value = "Y" And _
Worksheets("Sheet2").Range("Z" & J).Value = "" And _
Worksheets("Sheet1").Range("c" & I).Value <> Worksheets("Sheet2").Range("AF" & J).Value And _
Worksheets("Sheet1").Range("K" & I).Value <> Worksheets("Sheet2").Range("K" & J).Value And _
Worksheets("Sheet1").Range("N" & I).Value <> Worksheets("Sheet2").Range("L" & J).Value Then
ErrorMsg = "dates don't match"
ElseIf Sheets("Sheet1").Cells(I, 6).Value = Sheets("Sheet2").Cells(J, 2).Value And _
Worksheets("Sheet1").Range("B" & I).Value <> "Y" Then
ErrorMsg = "B column don't match"
ElseIf Sheets("Sheet1").Cells(I, 6).Value = Sheets("Sheet2").Cells(J, 2).Value And _
Worksheets("Sheet1").Range("B" & I).Value = "Y" And _
Worksheets("Sheet2").Range("Z" & J).Value <> "" Then
ErrorMsg = "Z column don't match"
Else: ErrorMsg = "ISIN don't match"
End If
Next J
Sheets("Sheet1").Rows(I).Copy Destination:=Sheets("mismatch").Rows(lastRowM)
Worksheets("mismatch").Range("S" & lastRowM).Value = ErrorMsg
lastRowM = lastRowM + 1
Next I
' stop screen from updating to speed things up
Application.ScreenUpdating = True
End Sub
First, I think you should add "Exit For" for each clause in If..else method. Otherwise it will lead to the fact that almost of your "miss match" result will be "ISIN don't match".
Second, I think you should set ErrorMsg = "" before For J = LastRowISINNR To 2 Step -1, and have condition ErrorMsg <> "" when you input result in sheet miss match.
Sheets("Sheet1").Rows(I).Copy Destination:=Sheets("mismatch").Rows(lastRowM)
Worksheets("mismatch").Range("S" & lastRowM).Value = ErrorMsg
lastRowM = lastRowM + 1
Otherwise, all your row even match or missmatch will input into miss match sheet.