VBA: VLookup between two workbooks - vba

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

Related

VBA rename sheet based on cell value

I want a VBA code that rename my sheetXXX, where XXX is the value in the cell B5 in “Sheet1” sheet. The macro should work for any value in B5.
I tried the following code:
Sub tabname()
Dim sheetXXX As Worksheet
XXX.Name = Worksheets("Sheet1").Range("B5").Value
End Sub
You have to set the object = to the actual worksheet to be renamed.
Sub tabname()
Dim sheetXXX As Worksheet
Set sheetXXX = ActiveWorkbook.Sheets("sheetXXX")
sheetXXX.Name = "Sheet" & Worksheets("Sheet1").Range("B5").Value
End Sub
If sheetXXX is meant to be the active worksheet you would do this.
Sub tabname()
Dim sheetXXX As Worksheet
Set sheetXXX = ActiveWorkbook.Activesheet
sheetXXX.Name = "Sheet" & Worksheets("Sheet1").Range("B5").Value
End Sub

Changing value of TextBox due to selection of ComboBox VBA Excel

I have a project in which I have to change to value of a textbox to a value that is searched in a workseet against a vlaue that has been selected from a combobox. for example if I select "A" from the combobox the it should search the worksheet "test" find the input for A and change the text box value to 1 as this is the value entered for A. I have looked at some of the other questions that have been asked here but could not seem to get it to work for me. Below is the code that I have been trying to use.
Private Sub IDComboBox_Change()
Dim domainRange As Range
Dim listRange As Range
Dim selectedString As Variant
Dim lastRow As Long
If IDComboBox.ListIndex <> -1 Then
selectedString = IDComboBox.Value
lastRow = Worksheets("test").Range("A" & Rows.Count).End(xlUp).Row
Set listRange = Worksheets("test").Range("A2:A" & lastRow)
For Each domainRange In listRange
If domainRange.Value = selectedString Then
DomainOwnerTestBox.Value = "test"
End If
Next domainRange
End If
End Sub
Any help would be great. If you need anymore information then please let me know and also please be paient with me as im new to VBA.
Thanks
Try this code. It uses Excel built-in MATCH function to search for value in column A of worksheet 'test'.
Private Sub IDComboBox_Change()
Dim wks As Excel.Worksheet
Dim selectedString As Variant
Dim row As Long
Dim value As Variant
Set wks = Worksheets("test")
If IDComboBox.ListIndex <> -1 Then
selectedString = IDComboBox.value
On Error Resume Next
row = Application.WorksheetFunction.Match(selectedString, wks.Columns(1), 0)
On Error GoTo 0
If row Then
value = wks.Cells(row, 2) '<--- assuming that input values are in column 2.
DomainOwnerTestBox.value = value
Else
'Value not found in the worksheet 'test'
End If
End If
End Sub

.find works for me in one procedure but not another

Hello I have the code below. Essentially, it grabs unique values of a certain range in each worksheet and adds it to a range on the side of the same worksheet.
The .find method is not working for me like it does in another procedure and I would like an explanation why or what I am doing wrong or the difference between the behavior of the code when written differently. make sense?
sub methodtwo()
Dim cell As Range
Dim strDATE As String
Dim datehr As Range
For i = 1 To Sheets.Count - 4
Sheets(i).Activate
Set datehr = Sheets(i).Range("H2", Sheets(i).Range("H2").End(xlDown))
For Each cell In datehr
strDATE = cell.Value
Set cell = Sheets(i).Range("L1:L400").Find(What:=strName)
If cell Is Nothing Then
Sheets(i).Range("L1").End(xlDown).Offset(1, 0).Value = cell
End If
Next cell
Next i
End Sub
below is the code I have written before and a reference for writing the code above. In the code below, the find method works perfectly and adds unique values to the designated range...the code above does not.
Sub methodone()
Dim sh As Worksheet
Dim r As Long
Dim a As Range
Dim al As Range
Dim strName As String
For Each sh In Worksheets
sh.Activate
sh.Range("K1").Activate
Set al = ActiveSheet.Range("A2:A13000")
For Each a In al
strName = a.Value
Set Cell = ActiveSheet.Range("K1:K400").Find(What:=strName)
If Cell Is Nothing Then
ActiveSheet.Range("K1").End(xlDown).Offset(1, 0).Value = a
End If
Next a
Next sh
End Sub
I wanted the methodtwo() to do the exact same thing as methodone() except on the last 4 sheets.
Is the problem obvious? I'm working on my attention to detail..especially when using a previously written code for reference.
for methodone() I just had to change strNAME to strDATE which is a detail error when converting one procedure to the other. I also changed the "cell" after the IF statement to "strDATE"
sub methodtwo()
Dim cell As Range
Dim strDATE As String
Dim datehr As Range
For i = 1 To Sheets.Count - 4
Sheets(i).Activate
Set datehr = Sheets(i).Range("H2", Sheets(i).Range("H2").End(xlDown))
For Each cell In datehr
strDATE = cell.Value
Set cell = Sheets(i).Range("L1:L400").Find(What:=strDATE)
If cell Is Nothing Then
Sheets(i).Range("L1").End(xlDown).Offset(1, 0).Value = strDATE
End If
Next cell
Next i
end sub

How make Excel select the same cell when changing sheets?

I have Excel workbook with 3 sheets. I want to use a macro which will select the same cell when changing sheets.
Example:
I am in sheet1 cell A3 when I switch to sheet2. I want A3 in sheet2 to be selected. Same thing when I switch to sheet3.
Is it possible?
I tried using events sheet_activate, sheet_deactivate, and sheet_change. The last one is surely wrong.
You were close. This uses a module-level variable to store the ActiveCell address any time the SheetSelectionChange event fires:
Dim ActiveCellAddress As String
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Application.ScreenUpdating = False
Sh.Range(ActiveCellAddress).Activate
Application.ScreenUpdating = True
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
ActiveCellAddress = ActiveCell.Address
End Sub
Here is a one-way example. If you start on Sheet1 and select either Sheet2 or Sheet3, you will stay on the same address as you were on Sheet1.
In a standard module, include the single line:
Public addy As String
In the Sheet1 code area, include the following event macro:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
addy = ActiveCell.Address
End Sub
In both the Sheet2 and Sheet3 code areas, include the following event macro:
Private Sub Worksheet_Activate()
If addy <> "" Then
Range(addy).Select
End If
End Sub
I use the following macro to select cell A1 on all sheets within a workbook. I assigned this macro to a button on a toolbar. You can modify it to make it work for when you change sheets.
Sub Select_Cell_A1_on_all_Sheets()
Application.ScreenUpdating = False
On Error Resume Next
Dim J As Integer
Dim NumSheets As Integer
Dim SheetName As String
CurrentSheetName = ActiveSheet.Name
NumSheets = Sheets.Count
For J = 1 To NumSheets
SheetName = Sheets(J).Name
Worksheets(SheetName).Activate
Range("A1").Select
Next J
Worksheets(CurrentSheetName).Activate

VBA code to check each sheet, locate a cell containing =TODAY() function, and select that cell

I have a workbook with 12 worksheets each named JANUARY through FEBRUARY.
Only the current month's sheet (e.g., NOVEMBER) will ever contain a cell containing the function =TODAY() in mm/dd/yyyy date format.
When I open the workbook, I want to automatically activate the Sheet that contains this cell (in my instance Cell N2) and Select it. I am truly a newbie learning slowly, but knowledge is minimal and can't find what I need. This what I have so far, but it doesn't work:
Sub ChooseSheet()
Dim SearchString As Variant
SearchString = "TODAY()" 'string I am searching for
Do Until SearchString = "TODAY()"
If Application.WorksheetFunction.CountIf(Sheets("Sheet1").Columns(14), SearchString) > 0 Then
Worksheets("Sheet1").Activate
End If
Exit Do
Loop
End Sub
This works for me.
Sub searchToday()
Dim sh As Worksheet
Dim found As Range
For Each sh In ActiveWorkbook.Worksheets
Set found = sh.Cells.Find(what:="=TODAY()", LookIn:=xlFormulas)
If Not found Is Nothing Then
sh.Activate
found.Select
Exit Sub
End If
Next sh
End Sub
Sub Test()
Dim ws As Worksheet
Dim f As Range
For Each ws In ActiveWorkbook.Worksheets
Set f = ws.Cells.Find(What:="=TODAY()", LookIn:=xlFormulas, LookAt:=xlWhole)
If Not f Is Nothing Then
ws.Activate
f.Select
Exit For
End If
Next ws
End Sub