Extracting the item from a DICTIONARY in VBA - vba

I have created a dictionary that stores the sheet name and its number.
So the code is as:
Sub SetDiction()
Dim num as Excel.Range
Dim wks As Excel.Worksheet
For each wks in ThisWorkbook.Worksheets
Set num = Nothing
Set num = wks.Range("SheetNumber")
If not(num is Nothing) Then
rModule.rDictionary.Add:=num.Value Item:=wks
End If
Next
End Sub
Now am trying to get the wks name and put it in another worksheet.The code is:
Sub GetSheet()
Dim key as variant
For each key in rModule.rDictionary.Keys
With Sheet2
.Cells(2,1).Value = rModule.rDictionary.Item(key)
End With
End Sub
It is giving me application defined or Object-defined error.
Can some one help please?

Your .Add call is syntactically incorrect and you are adding the whole worksheet to the dictionary where presumably you just want to add the named range, change to:
rDictionary.Add num.Value, num
To add the name:
rDictionary.Add num.Value, wks.Name

Related

VBA Code for Vlookup on different worksheets within the same workbook

I am trying to write a vba script that will allow me to vlookup values from Sheet(3) to different Sheet(i) - and paste it on range"R2" on the Sheet(i) - I also want it to go to the end of the values in Column M on Sheet(i) [if this is possible]. I basically want to run through all the different "i" sheets on the workbook. Sheet (3) has all the data that needs to be copied on all the other "i" sheets.
I keep getting an error with my code below.
Sub CopyTableau1Data()
Dim wka As Worksheet
Dim wkb As Worksheet
ShtCount = ActiveWorkbook.Sheets.Count
For i = 9 To ShtCount
With ThisWorkbook
Set wka = .Sheets(i)
Set wkb = .Sheets(3)
End With
Worksheets(i).Activate
If IsError(Application.WorksheetFunction.VLookup(wka.Range("M2"), wkb.Range("E:T"), 14, 0)) Then
wka.Range("R2").Value = ""
Else
wka.Range("R2").Value = Application.WorksheetFunction.VLookup(wka.Range("M2"), wks.Range("E:T"), 14, 0)
End If
Next i
End Sub
IsError does not work with Application.WorksheetFunction.VLookup or WorksheetFunction.VLookup, only with Application.VLookup.
It is faster and easier to return Application.Match once to a variant type variable and then test that for use.
dim am as variant
'are you sure you want wkb and not wks here?
am = Application.match(wka.Range("M2"), wkb.Range("E:E"), 0)
If IsError(am) Then
wka.Range("R2") = vbnullstring
Else
'are you sure you want wks and not wkb here?
wka.Range("R2") = wks.cells(am, "R").value
End If
Note the apparent misuse of wkb and wks in two places. I don't see the point of looking up a value in one worksheet, testing that return then using the results of the test to lookup the same value in another worksheet.
You can use the following code:
Sub CopyTableau1Data()
Dim wka As Worksheet
Dim wkb As Worksheet, i As Integer
ShtCount = ActiveWorkbook.Sheets.Count
For i = 9 To ShtCount
With ThisWorkbook
Set wka = .Sheets(i)
Set wkb = .Sheets(3)
End With
Worksheets(i).Activate
wka.Range("R2") = aVL(i)
Next i
End Sub
Function aVL(ByVal wsno As Integer) As String
On Error GoTo errhandler:
aVL =
Application.WorksheetFunction.VLookup(ActiveWorkbook.Worksheets(wsno).Range("M2"),
ActiveWorkbook.Worksheets(3).Range("E:T"), 14, False)
errhandler:
aVL = ""
End Function
When you try to check an error by isError, program flow can immediately return from the sub depending on the error. You could use on error in your sub to prevent that but this would only handle the first error. By delegating the error handling to a function you can repeatedly handle errors in your loop.
I assumed you wanted to use wkb.Range("E:T") instead of wks.Range("E:T").

Hiding rows using VB

My goal is to hide each row that contains a cell filled with red. Here is my code:
Sub AstInv()
Dim myTable As ListObject
Dim myArray As Variant
Set myTable = ActiveSheet.ListObjects("Sheet2")
Set myArray = myTable.ListColumns("Código de Barras2").Range
For Each cell In myArray
If Rng.Interior.Color = vbRed Then
rw.EntireRow.Hidden = True
End If
Next
End Sub
Each time I run it, I get this error:
Compile error: Invalid outside procedure
Please help! Thanks!
Your code is a bit disjointed and attempts to use variables that have not been dimmed or instantiated.
Sub AstInv()
Dim myTable As ListObject
Dim myArray As range
Set myTable = ActiveSheet.ListObjects("Table2")
Set myArray = myTable.ListColumns("Código de Barras2").Range
For Each cell In myArray
If cell.Interior.Color = vbRed Then
cell.EntireRow.Hidden = True
End If
Next
End Sub
There are several issues with your code:
Compile error: Invalid outside procedure
means that you have some random text at the top of your module (outside all Subs), as in:
random ' <- Invalid outside procedure
Sub AstInv1()
Dim myTable As ListObject
Dim myArray As Variant
...
But there are more issues:
It is unlikely that you have a table named "Sheet2"
Your ActiveSheet (the sheet currently visible) may not contain the intended table / ListObject
myArray is declared as Variant when it should be Range
Rng and rw objects are undeclared and, as mentioned, are not connected to any other objects
To fix them
Use Option Explicit - this will force you to declare all variables
Check your objects' names and location
In the code call your objects explicitly
Option Explicit
Public Sub AstInv()
Dim myTable As ListObject
Dim myCol As Range
Dim cell As Range
Set myTable = ThisWorkbook.Worksheets("Sheet2").ListObjects("Table1") 'Check names
Set myCol = myTable.ListColumns("Código de Barras2").Range
For Each cell In myCol
cell.EntireRow.Hidden = (cell.Interior.Color = vbRed)
Next
End Sub
This version uses an AutoFilter and shows how to avoid errors when objects are missing
Option Explicit
Public Sub AutoFilterRedCells()
Dim tbl As ListObject, col As Long
On Error Resume Next 'Ignore expected errors
Set tbl = ThisWorkbook.Worksheets("Sheet2").ListObjects("Table1") 'Check names
col = tbl.ListColumns("Código de Barras2").Range.Column
On Error GoTo 0 'Stop ignoring errors
If col > 0 Then tbl.Range.AutoFilter Field:=col, Operator:=xlFilterNoFill
End Sub

Private Sub User-Defined Type Not Defined Range Sheet

First post. I have the relatively simple code below and am getting a
User-defined type not defined
error. I know that the stand alone code works when I place it into one Sub but for various reasons I want to split it out so that in my larger workbook I can just call on the second sub rather than having to copy and paste the whole loop multiple times. The purpose of the code is to autosize the specified range in excel.
Sub letsGo()
Dim rng As Range
Dim sht As Worksheet
Set rng = ThisWorkbook.Sheets("Sheet1").Range("Range1")
Set sht = ThisWorkbook.Sheets("Sheet1")
Call whyDoesntThisWork(sht, rng)
End Sub
Private Sub whyDoesntThisWork(rangeSheet As Sheet, rangeTable As Range)
Dim Col As Range
Dim reSize As Range
For Each Col In rangeTable.Columns
If Col.Hidden = False Then
Set reSize = rangeSheet.Range(rangeSheet.Cells(rangeTable.Row, Col.Column), rangeSheet.Cells(rangeTable.Rows.Count, Col.Column)) reSize.Columns.autoFit
End If
Next Col
End Sub
You have two different data types:
Private Sub whyDoesntThisWork(rangeSheet As Sheet, rangeTable As Range)
rangeSheet is a Sheet, but when you call it, you pass:
Call whyDoesntThisWork(sht, rng)
sht is of type WorkSheet
That's your inconsistency. I recommend you change your definition to:
Private Sub whyDoesntThisWork(rangeSheet As WorkSheet, rangeTable As Range)
Change rangeSheet As Sheet to rangeSheet As Worksheet

activate method of worksheet class failed - vlookup - vba

I want to use VLOOKUP command and use a range which is in sheet B (not in the activated one A). Calling the new worksheet gives me an error of " 'runtime error 1004' activate method of worksheet class failed"
Public Sub Creation()
Worksheets("A").Activate
Randomize
Dim code As String
Dim hamid As Variant
Dim Lookup_Range As Range
Code = 100032
Set Lookup_Range = Worksheets("B").Range("O1:P8")
On Error Resume Next
hamid = Application.WorksheetFunction.VLookup(code, Lookup_Range, 2, False)
On Error GoTo 0
End sub
I have tried using With command to call the new worksheet but I was not successful. I am new to VBA so please bear with me.
Your lookup range seems to be in worksheet B. Try activating worksheet B before using the lookup function. I've encountered issues trying to define ranges on one worksheet while having another activated:
Public Sub Creation()
Worksheets("A").Activate
Randomize
Dim code As String
Dim hamid As Variant
Dim Lookup_Range As Range
code = 100032
'Try here:
Worksheets("B").Activate
Set Lookup_Range = Worksheets("B").Range("O1:P8")
On Error Resume Next
'or here:
Worksheets("B").Activate
hamid = Application.WorksheetFunction.VLookup(code, Lookup_Range, 2, False)
On Error GoTo 0
'also made 'Code' in lookup function 'code'.
End Sub

VBA: VLookup between two workbooks

I am wondering if someone can help me out. I created a Userform with 3 comboboxes. Combobox 1 and 2 list all open workbooks. Combobox 3 lists the worksheets from Combobox 2. I now want to run a Vlookup. The lookup values are the values (in this case product codes) in each cell beginning at D9 to the last cell with a value in Column D of the first Worksheet of Combobox2's. The lookup range will be ("A5:S###"[number of rows varies depending on the file]").
The Vlookup formula should be in the Column I of the first Worksheet of Combobox2's value starting at "I9" looping through each cell in I9 until all the Codes in D9 are looked up.
I keep getting error the major one being “Runtime-error '9'”: Subscript out of range. Here is my code.
Option Explicit
Private Sub CancelButton_Click()
Stopped = True
Unload Me
End Sub
Private Sub ComboBox1_Change()
Dim ScheduleA As Workbook
Dim Termset As Worksheet
Set ScheduleA = Workbooks(Me.ComboBox1.Value)
With Me.ComboBox3
For Each Termset In ScheduleA.Worksheets
.AddItem Termset.Name
Next Termset
End With
End Sub
Private Sub FillACDButton_Click()
Dim ACDRebateInfo As Worksheet
Dim lastRow As Long
Dim NewRebate As Single
Dim NewRebateType As String
Dim LookUp_Range As Range
Dim ActionCode As String
Dim ACD_NewRebate As Range
Dim ACD_NewRebateType As Range
Dim ACD_ActionCode As Range
Dim SCC As Range
Dim Cell As Range
Set ACDRebateInfo = Workbooks(Me.ComboBox2.Value).Worksheets(1)
Set ACD_NewRebate = ACDRebateInfo.Range("I9:I500")
Set ACD_NewRebateType = ACDRebateInfo.Range("J9:J500")
Set ACD_ActionCode = ACDRebateInfo.Range("B9:B500")
Set LookUp_Range = Worksheets(Me.ComboBox3.Value).Range("A5:S400")
Set SCC = ACDRebateInfo.Range("D9:D230")
With ACDRebateInfo
For Each Cell In ACD_ActionCode
ActionCode = Application.WorksheetFunction.VLookup(SCC, LookUp_Range, 17, False)
Next Cell
End With
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim wkb As Workbook
For Each wkb In Application.Workbooks
Me.ComboBox1.AddItem wkb.Name
Me.ComboBox2.AddItem wkb.Name
Next wkb
End Sub
Not sure this is your issue but this piece of code does not make sense:
For Each Cell In ACD_ActionCode
ActionCode = Application.WorksheetFunction.VLookup(SCC, LookUp_Range, 17, False)
Next Cell
You are looping through the Action Codes but not using the Cell variable