I can't figure it out. I'm trying to make my formular more dynamic. But it always says prev can not be found, but I set prev as a worksheet.
PrevSheetName gives back the name of the previous worksheet (that works).
Please help me, in my other code I always tried to use "ActiveSheet.Previous" but it seems not to work with formulas.
Set prev = Worksheets(PrevSheetName)
Set rng = ActiveSheet.Range("D3")
rng.FormulaR1C1 = "=SUMIF(prev!C[1],RC[-2],prev!C[5])"
Range("D3").Copy Range("D4:D" & lRow)
This is my first code and that works
Set rng = ActiveSheet.Range("D3")
rng.FormulaR1C1 = "=SUMIF('Projekt 1'!C[1],RC[-2],'Projekt 1'!C[5])"
Range("D3").Copy Range("D4:D" & lRow)
and this is my PrevSheetName, is already puts the name in " "
Function PrevSheetName(Optional ByVal WS As Worksheet = Nothing) As String
Application.Volatile True
Dim S As String
Dim Q As String
If IsObject(Application.Caller) = True Then
Set WS = Application.Caller.Worksheet
If WS.Index = 1 Then
With Application.Caller.Worksheet.Parent.Worksheets
Set WS = .Item(.Count)
End With
Else
Set WS = WS.Previous
End If
If InStr(1, WS.Name, " ", vbBinaryCompare) > 0 Then
Q = "'"
Else
Q = vbNullString
End If
Else
If WS Is Nothing Then
Set WS = ActiveSheet
End If
If WS.Index = 1 Then
With WS.Parent.Worksheets
Set WS = .Item(.Count)
End With
Else
Set WS = WS.Previous
End If
Q = vbNullString
End If
PrevSheetName = Q & WS.Name & Q
End Function
I just want to exchange 'Projekt 1' with the previous sheet
If your sheet name has spaces as well as concatention you will need to add ' around the name in the formula like this "=SUMIF('" & PrevSheetName & "'!C[1],RC[-2],'" & PrevSheetName & "'!C[5])"
prev is a literal part of the formula. It is looking for sheet called "prev". You need to concatenate formula: "=SUMIF(" & PrevSheetName & "!C[1],RC[-2]," & PrevSheetName & "!C[5])"
Related
I am trying to make a code to loop the column b and then fill column c based on if its empty or not but its not working when I set the data into the middel of the excel sheet
Sub FillCellFromAbove()
Dim x As Integer
Dim y As Integer
y = Application.WorksheetFunction.Count(Range("B:B")) + 1
For x = 1 To y
Range("C3:C7" & x).Select
If Range("B" & x) = "" Then
ActiveCell.Value = "Yes"
ElseIf Range("B" & x) <> "" Then
ActiveCell.Value = "NO"
End If
Next x
End Sub
Range("C3:C7" & x).Select is selecting a range starting at C3 and ending at C71 for the first loop and C72 for the second. Doubt that is what you want.
Also COUNT only counts the cells with numbers not the cells in a range from the first cell with a value to the last. So in this case you would return 4 and do 4 loops.
Use:
Sub FillCellFromAbove()
Dim x As Long
Dim y As Long
With ActiveSheet 'Better to set actual sheet
y = .Cells(.Rows.Count,2).End(XlUp).Row
For x = 3 To y
If .Cells(x,2) <> "" Then
.Cells(x,3) = "Yes"
Else
.Cells(x,3) = "No"
End If
Next x
End With
End Sub
Flag Empty and Non-Empty Using Evaluate
Sub FlagEmptyNonEmpty()
Const SourceColumn As String = "B"
Const DestinationColumn As String = "C"
Const YesFlag As String = "Yes"
Const NoFlag As String = "No"
Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
With Intersect(ws.UsedRange, ws.Columns(SourceColumn))
.EntireRow.Columns(DestinationColumn).Value _
= ws.Evaluate("IF(ISBLANK(" & .Address(0, 0) & "),""" _
& YesFlag & """,""" & NoFlag & """)")
End With
End Sub
I have a working macro which changes a linked sheet in a cell according to month. Say from April to March.
From
='C:\Data\Name\[Time.xlsx]2021-04!A1"
to
='C:\Data\Name\[Time.xlsx]2021-05!A1".
This works as long as the user remembers to add a new sheet at the beginning of each month, which is not always done in time. As a result i get a "sheet cannot be found -> choose one from below" Prompt". How can I avoid this selector and add a "table not found" string in the cell instead and move on to the next operation in the loop?
Thanks!
EDIT:
Code Added upon request:
Sub Month()
Set rngB = Range("B2:B6")
strColB = "Range("B1")
iRowB = 1
strMonth = InputBox ("Insert Month as integer","Month")
strMonth = Trim(strMonth)
For Each cellB In rngB
cellB.Formula = "='C:Data\[" & strColB & "Time.xlsx]2021-" & strMonth & "'!B" & iRowB
iRowB = iRowB + 1
Next cellB
End Sub
Here's an easy function to test if a sheet exists prior to accessing its cells
Function SheetExists(ByVal SheetName As String, ByRef InWorkbook As Workbook) As Boolean
On Error Resume Next
SheetExists = Not InWorkbook.Sheets(SheetName) Is Nothing
On Error GoTo 0
End Function
Here's how you would use it.
Sub test()
MsgBox SheetExists("2021-04", Application.Workbooks("Time.xlsx"))
End Sub
Another example:
Sub test()
If SheetExists("2021-04", Application.Workbooks("Time.xlsx")) Then
'do stuff
Else
[a1] = "table not found"
End If
End Sub
Edit:
After the code was added to the original post. Here is an example of how to implement this function with that code:
Sub Month()
Set rngB = Range("B2:B6")
strColB = Range("B1").Text
iRowB = 1
strMonth = InputBox("Insert Month as integer", "Month")
strMonth = Trim(strMonth)
For Each cellB In rngB
If SheetExists("2021-" & strMonth, Application.Workbooks("Time.xlsx")) Then
cellB.Formula = "='C:Data\[" & strColB & "Time.xlsx]2021-" & strMonth & "'!B" & iRowB
Else
cellB.Formula = "table not found"
End If
iRowB = iRowB + 1
Next cellB
End Sub
I need to open two workbooks with same defined names, however different ranges, and highlight in one of the workbooks the differences of contents of every named range.
I compare hard coded ranges on one workbook with two sheets using the attached code.
Private Sub HighlightDifferences()
Dim setOne As Range
Dim setTwo As Range
Set setOne = Sheets("Sheet1").Range("Ongoing_Activities")
Set setTwo = Sheets("Sheet1 (2)").Range("Ongoing_Activities")
'REMOVE THE COLOR FILL
setOne.Interior.ColorIndex = xlNone
For Each cellitem In setOne
If Not StrComp(cellitem, cellitem2, vbBinaryCompare) = 0 Then
cellitem.Interior.ColorIndex = 6
End If
For Each cellitem2 In setTwo
If StrComp(cellitem, cellitem2, vbBinaryCompare) = 0 Then
cellitem.Interior.ColorIndex = 0
End If
Next cellitem2
Next cellitem
End Sub
Please, try the next code:
Sub compareNamesTwoWorkbooks()
Dim wb1 As Workbook, wb2 As Workbook, N1 As Name, N2 As Name, i As Long, j As Long
Dim rngN1 As Range, rngN2 As Range, boolFound As Boolean
Set wb1 = Workbooks("first workbook.xlsx")
Set wb2 = Workbooks("second workbook.xlsx")
For Each N1 In wb1.Names
For Each N2 In wb2.Names
If N1.RefersTo = N2.RefersTo Then
Set rngN1 = Application.Evaluate("'[" & wb1.Name & "]" & _
Replace(Replace(N1.RefersTo, "=", ""), "!", "'!"))
Set rngN2 = Application.Evaluate("'[" & wb2.Name & "]" & _
Replace(Replace(N2.RefersTo, "=", ""), "!", "'!"))
rngN1.Interior.ColorIndex = xlNone: 'rngN1.Parent.Activate: Stop
For i = 1 To rngN1.rows.count
For j = 1 To rngN1.Columns.count
If Not StrComp(rngN1.cells(i, j).Value, _
rngN2.cells(i, j).Value, vbBinaryCompare) = 0 Then
rngN1.cells(i, j).Interior.ColorIndex = 6
End If
Next j
Next i
boolFound = True: Exit For
End If
Next N2
If Not boolFound Then Debug.Print "Names """ & N1.Name & _
""" could not be found in workbook """ & wb2.Name
boolFound = False
Next N1
End Sub
Please, take care of using your real names to define wb1 and wb2` workbooks. Of course, they must be open. They can also be open by the program if needed.
After testing, some feedback would be appreciated...
I am working with cells in a column, which have to be split. Element 1 of the string is supposed to be posted separately from Element 2 of the same string, each on another Worksheet.
String "123 ABC" -> "123" in column C and "ABC" in column D
I am running into a Runtime-Error 9 "Index out of Range" if one of the cells I am checking only contains "123" or "ABC" but no both parts.
I tried to work around it in the way you see in my code below. Needless to say it does not work.
Could one of the more experienced Excel-Gurus help me out here?
Thank you in advance for your time!
Application.ScreenUpdating = False
Dim wbInput As Workbook, wbOutput As Workbook
Set wbOutput = ActiveWorkbook
Dim wsInput As Worksheet, wsOutput As Worksheet, wsMistakes As Worksheet
Set wsOutput = wbOutput.Worksheets("FehlerVorkommen")
Set wsMistakes = wbOutput.Worksheets("NichtZuweisbar")
Dim lRowInput As Long, lRowOutput As Long, lRowMistakes As Long
Dim Lieferant As Range
Dim InputFile As String, myElements() As String
lRowOutput = wsOutput.Range("A" & Rows.Count).End(xlUp).Row
wsOutput.Range("A2:G" & lRowOutput).Clear
wsMistakes.Range("A2:G500").Clear
InputFile = Application.GetOpenFilename()
If InputFile = "Falsch" Then
Exit Sub
End If
Set wbInput = Workbooks.Open(InputFile)
Set wsInput = wbInput.Worksheets("owssvr")
lRowInput = wsInput.Range("A" & Rows.Count).End(xlUp).Row
'Get all Information
For Each Lieferant In wsInput.Columns(1).Rows("2:" & lRowInput)
If wsInput.Columns(3).Rows(Lieferant.Row) <> vbNullString Then
myElements = Split(wsInput.Columns(3).Rows(Lieferant.Row).Value, " ", 2) 'A maximum of 2 String-Parts to avoid 4-5 splits whenever there is a GmbH or AG or whatever
If IsEmpty(myElements(1)) = True Then <<<<<<<<<ERROR HERE<<<<<<<<<<<
lRowMistakes = wsMistakes.Range("A" & Rows.Count).End(xlUp).Row
NextRow = lRowMistakes + 1
wsInput.Columns(1).Rows(Lieferant.Row).Copy Destination:=wsMistakes.Columns(1).Rows(NextRow)
NextRow = NextRow + 1
Else
If IsNumeric(wsInput.Columns(1).Rows(Lieferant.Row)) = True And wsInput.Columns(1).Rows(Lieferant.Row) <> vbNullString _
And IsNumeric(wsInput.Columns(2).Rows(Lieferant.Row)) = True And wsInput.Columns(2).Rows(Lieferant.Row) <> vbNullString Then
wsInput.Columns(1).Rows("2:" & lRowInput).Copy Destination:=wsOutput.Columns(1).Rows("2:" & lRowInput) 'Task Namen
wsInput.Columns(2).Rows("2:" & lRowInput).Copy Destination:=wsOutput.Columns(2).Rows("2:" & lRowInput) 'Bestellpositionen
wsOutput.Columns(3).Rows(Lieferant.Row).Value = myElements(0) 'ID
wsOutput.Columns(4).Rows(Lieferant.Row).Value = myElements(1) 'Name
wsInput.Columns(3).Rows("2:" & lRowInput).Copy Destination:=wsOutput.Columns(5).Rows("2:" & lRowInput) 'Fehlerarten
Else 'Get all wrong inputs on separate Sheet
lRowMistakes = wsMistakes.Range("A" & Rows.Count).End(xlUp).Row
NextRow = lRowMistakes + 1
wsInput.Columns(1).Rows(Lieferant.Row).Copy Destination:=wsMistakes.Columns(1).Rows(NextRow)
NextRow = NextRow + 1
End If
End If
Else 'Get all wrong input on separate Sheet
lRowMistakes = wsMistakes.Range("A" & Rows.Count).End(xlUp).Row
NextRow = lRowMistakes + 1
wsInput.Columns(1).Rows(Lieferant.Row).Copy Destination:=wsMistakes.Columns(1).Rows(NextRow)
NextRow = NextRow + 1
End If
Next Lieferant
wbInput.Close
This line doesn't do what you think it's doing:
If IsEmpty(myElements(1)) = True
First, specifying a limit for the Split function doesn't mean that you always get that many elements in the array. Second, IsEmpty tests to see if a Variant is type VT_EMPTY, not whether a String has a value (Split returns a strongly typed array).
Just test the UBound instead:
If UBound(myElements) > 0 Then
I have SUMIF running really really slow. My data has 14,800 Rows and 39 Columns.
I do the following:
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
EDITED TO ADD more potentially relevant code that may be interacting with the SUMIF command
It may be relevant to the speed issue so I'll mention it. I get the user to open a file from wherever they may have stored the report. The file then stays open. Maybe that is a problem. I don't know if it should be some other way.. like I close it but keep the address in mind or something??
FilterType = "Text Files (*.txt),*.txt," & "Comma Separated Files (*.csv),*.csv," & "ASCII Files (*.asc),*.asc," & "All Files (*.*),*.*"
FilterIndex = 4
Title = "File to be Selected"
File_path = Application.GetOpenFilename(FileFilter:=FilterType, FilterIndex:=FilterIndex, Title:=Title)
If File_path = "" Then
MsgBox "No file was selected."
Exit Sub
End If
Set wbSource = Workbooks.Open(File_path)
Original_Name = ActiveWorkbook.Name
If ActiveSheet.AutoFilterMode Then
ActiveSheet.AutoFilterMode = False
End If
Set wb1 = ActiveWorkbook
Set ws1 = wb1.Worksheets("Sheet1")
With ws1
FinalColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
FinalRow = .Range("B" & .Rows.Count).End(xlUp).Row
For j = 1 To FinalColumn
If .Cells(1, j).Value = "Effec.Date" Then
Effective_Date_Column = j
ElseIf .Cells(1, j).Value = "FolderId" Then
FolderId_column = j
ElseIf .Cells(1, j).Value = "FolderNotional" Then
FolderNotional_column = j
End If
Next j
'range_Total_Folder_Fixed = .Cells(2, Total_Folder_Column).Address & ":" & .Cells(FinalRow, Total_Folder_Column).Address
range_FolderId_Fixed = .Cells(2, FolderId_column).Address & ":" & .Cells(FinalRow, FolderId_column).Address
range_FolderId_Cell = .Cells(2, FolderId_column).Address(RowAbsolute:=False, ColumnAbsolute:=False)
range_FolderNotional_Fixed = .Cells(2, FolderNotional_column).Address & ":" & .Cells(FinalRow, FolderNotional_column).Address
Everything runs in 8-10 seconds until we come to the lie below. Now the total time jumps to a 150 seconds.
.Range(range_Total_Folder_Fixed).Formula = "=SUMIF(" & range_FolderId_Fixed & "," & range_FolderId_Cell & "," & range_FolderNotional_Fixed & ")"
Am I doing something wrong? Is there a better (more efficient) way to write a general formula?
EDIT: Code generated Raw Formula
Some of the excel worksheet functions in my code:
.Range(range_Isnumber).Formula = "=(RIGHT(" & range_TradeId_cell & ",2)<> ""IB"")*1"
.Range(range_Is_IB).Formula = "=(RIGHT(" & range_TradeId_cell & ",2)= ""IB"")*1"
.Range(range_Exceptions).Formula = "=(SUMIF(" & range_FolderId_Fixed & "," & range_FolderId_Cell & "," & range_Isnumber_fixed & ")= COUNTIF(" & range_FolderId_Fixed & "," & range_FolderId_Cell & "))*1+(SUMIF(" & range_FolderId_Fixed & "," & range_FolderId_Cell & "," & range_Is_IB_fixed & ")= COUNTIF(" & range_FolderId_Fixed & "," & range_FolderId_Cell & "))*1 "
.Range("C13").FormulaR1C1 = "=SUM(IF(FREQUENCY(MATCH([SCL_FL_2013_11_30.xlsx]Rest!R2C2:R2321C2,[SCL_FL_2013_11_30.xlsx]Rest!R2C2:R2321C2,0),MATCH([SCL_FL_2013_11_30.xlsx]Rest!R2C2:R2321C2,[SCL_FL_2013_11_30.xlsx]Rest!R2C2:R2321C2,0))>0,1))"
So Stuff like
Range("I2")=SUMIF($H$2:$H$5,H2,$G$2:$G$5)
Where the data could be like
RowG RowH RowI
Alice 1 4
Alice 3 4
Bob 9 17
Bob 8 17
Dan 2 2
EDIT2 : Implementing Sam's solution, I am getting errors:
Set range_FolderId_Fixed = .Range(.Cells(2, FolderId_column), .Cells(FinalRow, FolderId_column))
Set range_FolderId_Cell = .Range(.Cells(2, FolderId_column),.Cells(FinalRow, FolderId_column))
Set range_FolderNotional_Fixed = .Range(.Cells(2, FolderNotional_column), .Cells(FinalRow, FolderNotional_column))
Set range_Total_Folder_Fixed = .Range(.Cells(2, Total_Folder_Column), .Cells(FinalRow, Total_Folder_Column))
.Range(range_Total_Folder_Fixed).Value = SumIf_func(range_FolderId_Fixed, range_FolderId_Cell, range_FolderNotional_Fixed)
I am getting a type application defined or object defined error in the line below.
.Range(range_Total_Folder_Fixed).Value = SumIf_func(range_FolderId_Fixed, range_FolderId_Cell, range_FolderNotional_Fixed)
I have no idea what to do next.
Ok this is what I came up with
Public Function SumIf_func(rng As Range, _
criteria As Range, _
sumRange As Range) As Variant()
Dim rngArr() As Variant
Dim sumArr() As Variant
Dim criteriaArr() As Variant
Dim returnArr() As Variant
Dim temp As Double
rngArr = rng.Value2
sumArr = sumRange.Value2
criteriaArr = criteria.Value2
If UBound(sumArr) <> UBound(rngArr) Then _
Err.Raise 12345, "SumIf_func", "Sum range and check range should be the same size"
If UBound(sumArr, 2) <> 1 Or UBound(rngArr, 2) <> 1 Then _
Err.Raise 12346, "SumIf_func", "Sum range and check range should be a single column"
ReDim returnArr(1 To UBound(criteriaArr), 1 To 1)
For c = LBound(criteriaArr) To UBound(criteriaArr)
returnArr(c, 1) = Application.WorksheetFunction.SumIf(rng, criteriaArr(c, 1), sumRange)
Next c
SumIf_func = returnArr
End Function
This function takes in three ranges:
The range to check
The range where the criteria are
The range where the values to sum are
The range to check and the sum range should both be the same length and only be 1 column across.
The array that is returned will be the same size as the criteria array..
Here is an example of usage:
Public Sub test_SumIf()
Dim ws As Worksheet
Set ws = Sheet1
Dim rng As Range, sumRng As Range, criteria As Range
Set rng = ws.Range("A1:A100")
Set sumRng = ws.Range("B1:B100")
Set criteria = ws.Range("C1:C10")
ws.Range("D1:D10").Value = SumIf_func(rng, criteria, sumRng)
End Sub