I need to create an IF AND THEN statement in my vba. I've tried this code below and although I get no errors it doesn't work (ie: nothing happens when I run the macro):
Sub PrintAll()
Dim BrokerCell As Range
Dim Rng As Range
Dim Wks As Worksheet
Set Wks = Worksheets("PRINT PAGE")
If Range("$A$5").Value = "Company 1" Then
Set Rng = ThisWorkbook.Names("Company1").RefersToRange
ElseIf Range("$A$5").Value = "Company2" Then
Set Rng = ThisWorkbook.Names("Company2").RefersToRange
Else: Set Rng = ThisWorkbook.Names("Company3").RefersToRange
End If
For Each BrokerCell In Rng
If BrokerCell <> "" AND "$Q$5" > "0" Then
Wks.Range("$B$5").Value = BrokerCell.Text
Wks.PrintOut
End If
Next BrokerCell
End Sub
The macro works without the
AND "$Q$5" > "0"
so clearly I'm doing something wrong here.
You probably mean:
If BrokerCell <> "" And Range("$Q$5").Value > 0
You're comparing the literal string "$Q$5" to the literal string "0".
Related
I have a seemingly simple goal to turn the content of column B into comments of column A.
I have tried using the following code from #Dy.Lee mentioned here, but unfortunately it gives me a Run-time error '1004' Application-defined or object-defined error...
Sub Komentari()
Dim rngDB As Range, rngComent As Range
Dim rng As Range
Dim cm As Comment, i As Integer
Set rngComent = Range("A1:A50")
Set rngDB = Range("B1:B50")
For Each rng In rngComent
i = i + 1
If Not rng.Comment Is Nothing Then
rng.Comment.Delete
End If
Set cm = rng.AddComment
With cm
.Visible = False
.Text Text:=rngDB(i).value
End With
Next rng
End Sub
Can somebody, please, spot the mistake or suggest a better solution for this?
I'd go this way (explanations in comments):
Public Sub Komentari()
Dim rng As Range
With Range("A1:A50") ' reference comments range
.ClearComments ' clear its comments
For Each rng In .Offset(, 1).SpecialCells(xlCellTypeConstants) ' loop through refrenced range adjacent not empty cells
With rng.Offset(, -1).AddComment ' add comment to current rng corresponding comment range cell
.Visible = False
.Text rng.Value2
End With
Next
End With
End Sub
Sub Komentari()
Dim rngDB As Range, rngComent As Range
Dim rng As Range
Dim cm As Comment, i As Integer
Set rngComent = Range("A1:A50")
For Each rng In rngComent
i = i + 1
If Not rng.Range("B1").Comment Is Nothing Then
rng.Range("B1").Comment.Delete
End If
rng.Range("B1").AddComment (rng.Text)
Next rng
End Sub
Something like the following where you can use Offset to get the adjacent range, you drop the = when adding the text value to the comment, test that there is actually a value present first as well, and ensure you state the sheet to avoid implicit Activesheet reference.
Option Explicit
Public Sub Komentari()
Dim rngComent As Range
Dim rng As Range, cm As Comment
With ThisWorkbook.Worksheets("Sheet1")
Set rngComent = .Range("A1:A50")
For Each rng In rngComent
If Not rng.Comment Is Nothing Then
rng.Comment.Delete
End If
Set cm = rng.AddComment
With cm
.Visible = False
If rng.Offset(, 1) <> vbNullString Then .Text rng.Offset(0, 1).Value
End With
Next
End With
End Sub
Rather than add blank comments you could also flip this round to:
Option Explicit
Public Sub Komentari()
Dim rngComent As Range
Dim rng As Range, cm As Comment
With ThisWorkbook.Worksheets("Sheet1")
Set rngComent = .Range("A1:A50")
For Each rng In rngComent
If Not rng.Comment Is Nothing Then
rng.Comment.Delete
End If
If rng.Offset(, 1) <> vbNullString Then
Set cm = rng.AddComment
With cm
.Visible = False
.Text rng.Offset(0, 1).Value
End With
End If
Next
End With
End Sub
I am creating a macro that is supposed to separate and add new worksheets based off one worksheet with all the data in it.
It won't run and I'm not sure why.
My code keeps hitting a Run Time Error '9': Script out of range. I'm not sure if it has something to do with the first sub or the second sub.
The error occurs on line 16:
Set wsMain = wbMain.Sheets("MAIN")
First sub:
Option Explicit
Sub main()
Dim wbMain As Workbook
Dim wsMain As Worksheet
Dim rngMain As Range
Dim RngCategoryOne As Range
Dim RngCategoryTwo As Range
Dim RngCategoryThree As Range
Dim RngCategoryFour As Range
Dim RngCategoryFive As Range
Dim RngCategorySix As Range
Dim rng As Range
Dim SheetNames As Variant
Dim str As Variant
Set wbMain = ActiveWorkbook
Set wsMain = wbMain.Sheets("MAIN")
Set rngMain = wsMain.Range("F2:F3000")
For Each rng In rngMain
Select Case rng
Case "HO NMX_AMO", "HO NMX_EUR", "WTI NMX", "DIESEL OHR EIA_AMO"
If RngCategoryOne Is Nothing Then
Set RngCategoryOne = rng
Else
Set RngCategoryOne = Union(rng, RngCategoryOne)
End If
Case "WTI NMX_AMO"
If RngCategoryTwo Is Nothing Then
Set RngCategoryTwo = rng
Else
Set RngCategoryTwo = Union(rng, RngCategoryTwo)
End If
Case "NG HH NMX"
If RngCategoryThree Is Nothing Then
Set RngCategoryThree = rng
Else
Set RngCategoryThree = Union(rng, RngCategoryThree)
End If
Case "RBOB NMX_EUR", "RBOB NMX_AMO"
If RngCategoryFour Is Nothing Then
Set RngCategoryFour = rng
Else
Set RngCategoryFour = Union(rng, RngCategoryFour)
End If
Case "GO ICE_AMO"
If RngCategoryFive Is Nothing Then
Set RngCategoryFive = rng
Else
Set RngCategoryFive = Union(rng, RngCategoryFive)
End If
Case "C3 CONW INW OPIS_APO, C3 MBEL TET OPIS_APO"
If RngCategorySix Is Nothing Then
Set RngCategorySix = rng
Else
Set RngCategorySix = Union(rng, RngCategorySix)
SheetNames = Array("AT, LB, LC, AS", "AO", "LN", "RF, RA", "ULA2", "8K, BO")
For Each str In SheetNames
Call AddNewWorksheet(wbMain, str)
Next str
wbMain.Sheets("AT, LB, LC, AS").Range("A1:A" & RngCategoryOne.Count) = RngCategoryOne.Value
wbMain.Sheets("AO").Range("A1:A" & RngCategoryTwo.Count) = RngCategoryTwo.Value
wbMain.Sheets("LN").Range("A1:A" & RngCategoryThree.Count) = RngCategoryThree.Value
wbMain.Sheets("RF, RA").Range("A1:A" & RngCategoryFour.Count) = RngCategoryFour.Value
wbMain.Sheets("ULA2").Range("A1:A" & RngCategoryFive.Count) = RngCategoryFive.Value
wbMain.Sheets("8K, BO").Range("A1:A" & RngCategorySix.Count) = RngCategorySix.Value
wsMain.Activate
wsMain.Range("A1").Select
End If
End Select
Next
End Sub
Second Sub:
Sub AddNewWorksheet(ByRef wb As Workbook, ByVal wsName As Variant)
With wb.Sheets
.Add(after:=wb.Sheets(.Count)).Name = wsName
End With
End Sub
I'm getting a type mismatch error when I try to run this code on opening the workbook, the line highlighted by the debugger is the 2nd to last, I've added a comment to the code so you know where.
The line where there is an error is the same as a line of code further up so I'm unsure why I get a type mismatch error following the second loop.
I have tested the two loops separately in their own modules and it works fine. It's when I combine them into 1 module and try to run on opening the workbook that I get the error.
Private Sub Workbook_Open()
Dim rng As Range
Dim InputRng As Range, OutRng As Range
Set dt = CreateObject("Scripting.Dictionary")
Set InputRng = Worksheets("AA").Range("C2:AF366")
Set OutRng = Worksheets("Unique Lists").Range("A2")
For Each rng In InputRng
If rng.Value <> "" Then
dt(rng.Value) = ""
End If
Next
OutRng.Range("A1").Resize(dt.Count) = Application.WorksheetFunction.Transpose(dt.Keys)
Application.CutCopyMode = False
Set dt = CreateObject("Scripting.Dictionary")
Set InputRng = Worksheets("CT").Range("C2:AF366")
Set OutRng = Worksheets("Unique Lists").Range("B2")
For Each rng In InputRng
If rng.Value <> "" Then
dt(rng.Value) = ""
End If
Next
'ERROR OCCURS ON THE NEXT LINE
OutRng.Range("A1").Resize(dt.Count) = Application.WorksheetFunction.Transpose(dt.Keys)
End Sub
For info: the code is designed to create 2 unique lists from cell ranges on different worksheets upon opening the workbook.
Make sure you have data in your "CT" worksheet. If all of your cells inside Range("C2:AF366") don't have any values, then dt.Count = 0 (since your Dictionary is Empty), and this will result with a run-time error.
You already defined and set OutRng, in Set OutRng = Worksheets("Unique Lists").Range("B2"), so in your error line you can use:
OutRng.Resize(dt.Count) = Application.WorksheetFunction.Transpose(dt.Keys)
That's one way to debug dictionary, when you are not sure what do you have inside- take a look at the last lines:
Option Explicit
Public Sub TestMe()
Dim rng As Range
Dim InputRng As Range, OutRng As Range
Dim dt As Object
Set dt = CreateObject("Scripting.Dictionary")
Set InputRng = Worksheets("AA").Range("C2:AF366")
Set OutRng = Worksheets("Unique Lists").Range("A2")
For Each rng In InputRng
If rng.Value <> "" Then
dt(rng.Value) = ""
End If
Next
OutRng.Range("A1").Resize(dt.Count) = Application.WorksheetFunction.Transpose(dt.keys)
Application.CutCopyMode = False
Set dt = CreateObject("Scripting.Dictionary")
Set InputRng = Worksheets("CT").Range("C2:AF366")
Set OutRng = Worksheets("Unique Lists").Range("B2")
For Each rng In InputRng
If rng.Value <> "" Then
dt(rng.Value) = ""
End If
Next
'ERROR OCCURS ON THE NEXT LINE
OutRng.Range("A1").Resize(dt.Count) = Application.WorksheetFunction.Transpose(dt.keys)
Dim dtKey As Variant
For Each dtKey In dt.keys
Debug.Print dtKey
Next dtKey
End Sub
Indeed, your code works quite ok when dt.Count is not 0.
I need this macro to hide certain columns when the value of $A$5 is equal to "Company 2". The query below hides the columns successfully but doesn't executed the print loop. What's the correct way to set this up?
Sub PrintAll()
Dim BrokerCell As Range
Dim TotalCell As Range
Dim Rng As Range
Dim Wks As Worksheet
Set Wks = Worksheets("PRINT PAGE")
If Range("$A$5").Value = "Company 1" Then
Set Rng = ThisWorkbook.Names("Company1").RefersToRange
ElseIf Range("$A$5").Value = "Company 2" Then
Set Rng = ThisWorkbook.Names("Company2").RefersToRange
Else: Set Rng = ThisWorkbook.Names("Company3").RefersToRange
End If
If Range("$A$5").Value = "Company 2" Then
Columns("M:O").Select
Selection.EntireColumn.Hidden = True
Else: Columns("M:O").Select
Selection.EntireColumn.Hidden = False
For Each BrokerCell In Rng
If BrokerCell <> "" And Range("$S$5").Value <> "" Then
Wks.Range("$B$5").Value = BrokerCell.Text
Wks.PrintOut
End If
Next BrokerCell
End If
End Sub
Your For Each loop is contained within the Else portion of the If Range("$A$5").Value = "Company 2" Then statement. It will only execute when that If statement evaluates to false.
If you need your For Each loop to execute in all instances, then move it after the End If. If you need it to execute only when the If statement evaluates to True, then move it before the Else.
I believe this is what oyu are looking to accomplish, see below.
Sub PrintAll()
Dim BrokerCell As Range
Dim TotalCell As Range
Dim Rng As Range
Dim Wks As Worksheet
Dim sCellValue As String
Set Wks = Worksheets("PRINT PAGE")
sCellValue = Replace(Range("$A$5").Value, " ", "")
If sCellValue = "Company1" Then
Set Rng = ThisWorkbook.Names(sCellValue ).RefersToRange
ElseIf sCellValue = "Company2" Then
Set Rng = ThisWorkbook.Names(sCellValue ).RefersToRange
Else
Set Rng = ThisWorkbook.Names("Company3").RefersToRange
End If
Columns("M:O").Select
If sCellValue = "Company2" Then
Selection.EntireColumn.Hidden = True
Else
Selection.EntireColumn.Hidden = False
End If
For Each BrokerCell In Rng
If BrokerCell <> "" And Range("$S$5").Value <> "" Then
Wks.Range("$B$5").Value = BrokerCell.Text
Wks.PrintOut
End If
Next BrokerCell
End Sub
I'm a newbie at vba so please excuse my ignorance. I created a macro that will run through a dropdown list and print for each name in the dropdown - and it works:
Sub PrintAll()
Dim Cell As Range
Dim Rng As Range
Dim Wks As Worksheet
Set Wks = Worksheets("PRINT PAGE")
Set Rng = ThisWorkbook.Names("Brokers").RefersToRange
For Each Cell In Rng
If Cell <> "" Then
Wks.Range("$B$5").Value = Cell.Text
Wks.PrintOut
End If
Next Cell
End Sub
However, the workbook has multiple worksheets to read from and therefore I need the vba to read from multiple ranges so I tried this
Sub PrintAll()
Dim Cell As Range
Dim Cell2 As Range
Dim Rng As Range
Dim Wks As Worksheet
Set Wks = Worksheets("PRINT PAGE")
If "$A$5" = "Company1" Then Rng = ThisWorkbook.Names("1Brokers").RefersToRange
ElseIf "$A$5" = "Company2" Then Rng = ThisWorkbook.Names("2Brokers").RefersToRange
Else: Set Rng = ThisWorkbook.Names("3Brokers").RefersToRange
End If
For Each Cell In Rng
If Cell <> "" Then
Wks.Range("$B$5").Value = Cell.Text
Wks.PrintOut
End If
Next Cell
End Sub
The problem is I keep getting "Compile error Else without If" on the If statement. Is there something wrong with how I'm setting up the If statement or with how I'm using it in the code?
This block compiles for me. Please test it. I have always start set in the after then in if.
Sub PrintAll()
Dim Cell As Range
Dim Cell2 As Range
Dim Rng As Range
Dim Wks As Worksheet
'Set Wks = Worksheets("PRINT PAGE")
If "$A$5" = "Company1" Then
Rng = ThisWorkbook.Names("1Brokers").RefersToRange
ElseIf "$A$5" = "Company2" Then
Rng = ThisWorkbook.Names("2Brokers").RefersToRange
Else
Set Rng = ThisWorkbook.Names("3Brokers").RefersToRange
End If
For Each Cell In Rng
If Cell <> "" Then
Wks.Range("$B$5").Value = Cell.Text
Wks.PrintOut
End If
Next Cell
End Sub
Use
If Range("$A$5").Value = "Company1"..
Similarly for "$A$5".
"$A$5" is just a string and you are comparing a string to a string. What you want is a range object
EDIT
Regarding the Error that you are getting, you have to use Then
The syntax is (Hiten004 post made me realize it)
If <Cond> Then
ElseIF <Cond> Then
End If
Rather than:
If "$A$5" = "Company1" Then Rng = ThisWorkbook.Names("1Brokers").RefersToRange
use:
If "$A$5" = "Company1" Then Set Rng = ThisWorkbook.Names("1Brokers").RefersToRange
There may be other problems in your code.