Excel Macro For Data Analysis - vba

I'm building a spreadsheet macro that copies cells from one spreadsheet called DATA to a tab called REPORT based on criteria. If the criteria changes, the list clears and it adds the values that meet the new criteria. The macro is:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("B2:C5")
If Not Application.Intersect(KeyCells, Target) _
Is Nothing Then
For iRow = 2 To 5845
If Worksheets("DATA").Range("F" & iRow).Value = False Then
'Do nothing
Else
Worksheets("WORK").Cells(iRow, 1).Value = Worksheets("DATA").Cells(iRow, 4).Value
End If
Next iRow
End If
Call Worksheets("WORK").Delete_Blank_Rows
Sheets("REPORT").Range("E1:E5845").Value = Sheets("WORK").Range("A1:A5845").Value
Worksheets("REPORT").Columns(6).ClearContents
End Sub
Sub Delete_Blank_Rows()
On Error Resume Next
With Worksheets("WORK").Range("A2:A5845")
.Value = .Value
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub
The spreadsheet is here: https://drive.google.com/file/d/1G-RQ9DvGKa_EEapcLIWDf3_SCdql_dJJ/view?usp=sharing
The error I receive is
runtime error saying object doesn't support property or method.
Any help is appreciated!

Your Call method of your worksheet object appears to be causing the issue.
You are attempting to call a SUB by using it as a child object of a worksheet:
Call Worksheets("WORK").Delete_Blank_Rows
needs to be changed to
Delete_Blank_Rows
Also, remove the Call keyword. You don't need it.
Call Statement (Visual Basic)
You can use the Call keyword when you call a procedure. For most procedure calls, you aren’t required to use this keyword.
You typically use the Call keyword when the called expression doesn’t start with an identifier. Use of the Call keyword for other uses isn’t recommended.

Related

Getting rid of Merged cells With Center across selection

Hello Recently someone posted this in a comment thread in one of my previous questions. The post itself shows a code to remove merged cells and replace them with Central Across Selection
https://codereview.stackexchange.com/questions/197726/getting-rid-of-merged-cells/197730#197730
My issue is that I can't seem to get the code to work. I tried giving the code a go but am having two issues with it. Primarily the:
Sub fixMergedCells(sh As Worksheet)
and later
Set used = sh.UsedRange
Which I don't quite understand and they seem to be stopping me from applying it as a macro button. I otherwise seem to get a debug prompt saying "Method 'UnMerge' of object 'Range' failed" with regards to the line:
.UnMerge
Could you give me a hand in understanding what it is that I can't seem to grasp.
Here is my original code from my other post:
Sub fixMergedCells(sh As Worksheet)
'replace merged cells by Center Acroos Selection
'high perf version using a hack: https://stackoverflow.com/a/9452164/78522
Dim c As Range, used As Range
Dim m As Range, i As Long
Dim constFla: constFla = Array(xlConstants, xlFormulas)
Set used = sh.UsedRange
For i = 0 To 1 '1 run for constants, 1 for formulas
Err.Clear
On Error Resume Next
Set m = Intersect(used.Cells.SpecialCells(constFla(i)), used.Cells.SpecialCells(xlBlanks))
On Error GoTo 0
If Not m Is Nothing Then
For Each c In m.Cells
If c.MergeCells Then
With c.MergeArea
'Debug.Print .Address
.UnMerge
.HorizontalAlignment = xlCenterAcrossSelection
End With
End If
Next c
End If
Next i
End Sub
Sub test_fixMergedCells()
fixMergedCells ActiveSheet
End Sub
Your sub procedure isn't listed in the available 'macros' because it has a non-optional, non-variant parameter.
Try using an optional variant type parameter that can be used or, if omitted, filled with the ActiveSheet (which I assume the button is on).
Sub fixMergedCells(Optional sh As Variant)
If IsMissing(sh) Then Set sh = ActiveSheet
sh.Cells.UnMerge
End Sub
IsMissing can only be used with optional variant type parameters. Sub procedures with optional parameters are only listed as available 'macros' to be assigned to a button if the optional parameter is the variant type.

Can I create a Jump table in VBA for Excel?

I wrote a simple translator / parser to process an EDI (830) document using multiple Select Case statements to determine the code to be executed. I’m opening a file in binary mode and splitting the document into individual lines, then each line is split into the various elements where the first element of every line has a unique segment identifier.
My code works perfectly as written. However, Select Case requires checking every Case until a match is found or the Case Else is executed. I’ve sequenced the Case statements in such a manner that the segments that appear most frequently (as in the case of loops), are placed first to minimize the number of "checks before code is actually executed.
Rather than using multiple Select Cases, I would prefer to determine an index for the segment identifier and simply call the appropriate routine using that index. I’ve used jump tables in C and Assembler and anticipated similar functionality may be possible in VBA.
You can do jump tables in VBA by using the Application.Run method to call the appropriate routine by name. The following code demonstrates how it works:
Public Sub JumpTableDemo()
Dim avarIdentifiers() As Variant
avarIdentifiers = Array("Segment1", "Segment2")
Dim varIdentifier As Variant
For Each varIdentifier In avarIdentifiers
Run "Do_" & varIdentifier
Next varIdentifier
End Sub
Public Sub Do_Segment1()
Debug.Print "Segment1"
End Sub
Public Sub Do_Segment2()
Debug.Print "Segment2"
End Sub
You can do this in Excel VBA, following the example below:
The example assumes you have split your EDI document into two columns, one with the 'processing instruction' and one with the data that instruction will process.
The jump table is to the right i.e. a distinct list of the 'processing instructions' plus a name of a Sub-routine to run for each instruction.
The code is:
Option Explicit
Sub JumpTable()
Dim wsf As WorksheetFunction
Dim ws As Worksheet
Dim rngData As Range '<-- data from your file
Dim rngCell As Range '<-- current "instruction"
Dim rngJump As Range '<-- table of values and sub to run for value
Dim strJumpSub As String
Dim strJumpData As String
Set wsf = Application.WorksheetFunction '<-- just a coding shortcut
Set ws = ThisWorkbook.Worksheets("Sheet1") '<-- change to your worksheet
Set rngData = ws.Range("A2:A17") '<-- change to your range
Set rngJump = ws.Range("E2:F4") '<-- change to your circumstances
For Each rngCell In rngData
strJumpSub = wsf.VLookup(rngCell.Value, rngJump, 2, False) '<-- lookup the sub
strJumpData = rngCell.Offset(0, 1).Value '<-- get the data
Application.Run strJumpSub, strJumpData '<-- call the sub with the data
Next rngCell
End Sub
Sub do_foo(strData As String)
Debug.Print strData
End Sub
Sub do_bar(strData As String)
Debug.Print strData
End Sub
Sub do_baz(strData As String)
Debug.Print strData
End Sub
Make sure that you have written a Sub for each entry in the jump table.

Application or object defined error when trying to change background and font colors

I am trying to replace all of the conditional formatting of a spreadsheet (over 30 formatting rules). I have created a class module (called ConditionalFormatting) that has a series of subs for all the formatting rules, with one sub for each range that needs conditional formatting.
The only way I have thought to do this (open to suggestions) is by having the worksheet_change event call a sub in the ConditionalFormatting class called FormattingSubs which will call the correct sub to perform the formatting.
Here is the code for FormattingSubs:
Public Sub FormattingSubs(target As Range)
'have logic here to call the right sub based on what target.address
'is from the worksheet.change event
Select Case target.Name.Name
Case "head_pouch_lot_number"
Call HeadPouchLotNumber(target)
Case "head_consumed_pouch_lot"
Call HeadConsumedPouchLot(target)
Case "section_one_heading"
Call SectionOneHeading
End Select
End Sub
And here is the code for one of the formatting subs, HeadConsumedPouchLot: (note that the color variables are public constants defined in a separate module)
Public Sub HeadConsumedPouchLot(target As Range)
Dim head_consumed_pouch_lot As Range
Dim ws As Worksheet
Set head_consumed_pouch_lot = ActiveSheet.Range("head_consumed_pouch_lot")
Set ws = target.Worksheet
If target.address <> head_consumed_pouch_lot.address Then
Set target = head_consumed_pouch_lot
End If
With ws.Range(target.address)
If Range("section_one_heading").Value <> "" Then
.Interior.ColorIndex = red
.Font.ColorIndex = yellow
Else
.Interior.ColorIndex = lightgreen
.Font.ColorIndex = black
End If
End With
The problem is that when it goes to actually set the color, it gives me the 1004 error: "Application-defined or object-defined error."
What is wrong with my code?
The problem I figured out was that I needed to unprotect my sheet before I could make any changes to it! Thank you all for helping me look for answers.

Macro launching when a cell value changes due to a formula not by the user

I would like my Macro to launch whenever a value in a cell containing a formula changes.
i.e. the user is modifying another cell thus changing the value of the cell in question.
I have noticed that using the statement (found herein), only works if the user modifies the cell itself but not if the cell changes automatically - due to a formula as specified above.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A20")) Is Nothing Then ...
Any thoughts??
I tried to follow the answers from this question "automatically execute an Excel macro on a cell change" but it did not work...
Thanks in advance :)
A possible work-around comes from the fact that, to change a value, the user needs to change the selection first. So I would:
1) Declare a global variable called "oldValue" on top of the WS source code module:
Dim oldValue As Variant
2) Register the old value of your formula before the user types anything (let's say it's in Range("A4"), I let you adapt with the others):
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
oldValue = Range("A4")
End Sub
3) Check if the change has affected the formula in the Change event:
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("A4") <> oldValue Then
MsgBox "User action has affected your formula"
End If
End Sub
I've tested with a simple sum, I'm able to write cells that are not involved without any prompt but if I touch one of the cells involved in the sum the MsgBox will show up. I let you adapt for multiple cases, for user adding/removing rows (in that case I suggest to name the ranges containing the formulas you want to track) and the worksheet references.
EDIT I'd like to do it at once, not by going through 2 processes, is it possible? The problem is my macro involves a range containing more than one cell so it will be hard to store old values for 10 cells.
If ranges are next to each other, then instead of using a variable you can use a collection:
Dim oldValues As New Collection
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
For j = 1 To 10
oldValues.Add Range("A" & j).Value
Next j
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
For j = 1 To 10
If Range("A" & j).Value <> oldValues(j) Then
MsgBox "The value of Range(A" & j & ") has changed"
End If
Next j
End Sub
Of course, if ranges are not close to each other, you can just store them anyway in the SelectionChange event like this:
oldValues.Add Range("A1").Value
oldValues.Add Range("B7").Value
'...
and if you done this ONCE, with 10 ranges only, it should be a reasonable solution to your problem.
You said, "I would like my Macro to launch whenever a value in a cell containing a formula changes..."
If having your code run whenever a cell containing a formula is recalculated (which is not exactly what you asked for), one solution might be to create a VBA function that simply returns that value passed to it, plus does whatever else you want to do when the formula is recalculated...
Public Function Hook(ByVal vValue As Variant) As Variant
Hook = vValue
' Add your code here...
End Function
...then "wrap" your formula in a call to this function. For example, if the formula you are interested in is =A1+1, you would change this to =Hook(A1+1), and the Hook function would be called whenever A1+1 is recalculated (for example, when the value in A1 changes). However, it is possible that recalculating A1+1 will yield the same result and still call the Hook function (for example, if the user re-enters the same value in A1).
You can have a go at this:
First, in a Module Code declare a Public Variable.
Public r As Range, myVal '<~~ Place it in Module
Second, initialize your variables in Workbook_Open event.
Private Sub Workbook_Open()
Set r = Sheet1.Range("C2:C3") '<~~ Change to your actual sheet and range
myVal = Application.Transpose(r)
End Sub
Finally, set up your Worksheet_Calculate event.
Private Sub Worksheet_Calculate()
On Error GoTo halt
With Application
.EnableEvents = False
If Join(myVal) <> Join(.Transpose(r)) Then
MsgBox "Something changed in your range"
'~~> You put your cool stuff here
End If
myVal = .Transpose(r)
forward:
.EnableEvents = True
End With
Exit Sub
halt:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume forward
End Sub
Above will trigger the event when values in C2:C3 changes.
Not really very neat but works in detecting changes in your target range. HTH.
Declaring a module -level variable like Matteo describes is definitely one good way to go.
Brian 's answer is on the right track with regards to keeping all is the code in the same place, but it's missing one critical part : Application.Caller
When used in function that is called by a single cell, Application.Caller will return the Range object of that cell. This way you can store the old value within the function itself when it is called, then once you're done with calculating the new value you can compare it with the old and run more code as required.
Edit: The advantage with Application.Caller is that the solution scales in and of itself, and does not change no matter how the target cells are arranged (I.e. Continuous or not).

Methods in EXCEL Addin - XLL

How do I know which methods are available in my XLL module, in case i need to use / call any of them in my VBA code.
I can do this by calling the:
Application.Run()
method, in which I have to pass my macro-name as the parameter.
My question is about this macro-name: how do I know which macros are present in my XLL addin.
Any help is appreciated.
Cheers!!!!!!!!!!!
Tushar
You can use the Application.RegisteredFunctions method to give you a list of the functions in the XLLs that Excel has registered.
For example, the following code will list the XLL, the function name and the parameter types for the XLLs that are currently registered:
Public Sub ListRegisteredXLLFunctions()
Dim RegisteredFunctions As Variant
Dim i As Integer
RegisteredFunctions = Application.RegisteredFunctions
If IsNull(RegisteredFunctions) Then
Exit Sub
Else
Dim rng As Range
Set rng = Range("A1")
Set rng = rng.Resize(UBound(RegisteredFunctions, 1), UBound(RegisteredFunctions, 2))
rng.Value = RegisteredFunctions
End If
End Sub
Are you asking this from a code P.O.V? If you just want to check it out manually you can see that in the project explorer. Otherwise, I'd suggest just attempting to run the macro, but use an error handler in case the macro doesn't exist.
On Error GoTo badMacroCall
application.run(myMacro)
badMacroCall:
msgbox("That macro could not be run!")