I have some basic VBA that is allowing a user to take a field from one table and use it to update another table. It works fine when I step through it, but nothing happens when I run it using F5. I don't get any errors, just nothing happens.
I think it could possibly be that the value hasn't been assigned to one of the variables before the next step occurs, but I've never had that problem before, and I've always assumed VBA wouldn't move to the next step until it had completed the one it's on?
My code is below:
Option Explicit
Sub acceptDateComp()
'set data type
Dim dtType As String
dtType = "opportunity"
'declare sheets
Dim wsComp As Worksheet
Set wsComp = ThisWorkbook.Sheets(dtType & "Comp")
Dim wsBCE As Worksheet
Set wsBCE = ThisWorkbook.Sheets(dtType & "Snapshot")
Dim wsOffline As Worksheet
Set wsOffline = ThisWorkbook.Sheets(dtType & "Database")
'declare tables
Dim bce As ListObject
Set bce = wsBCE.ListObjects(dtType & "Snapshot")
Dim offline As ListObject
Set offline = wsOffline.ListObjects(dtType & "Database")
Dim dateComp As ListObject
Set dateComp = wsComp.ListObjects(dtType & "DateComp")
'declare heights and areas
Dim offlineRange As Range
Set offlineRange = offline.ListColumns(1).DataBodyRange
'check for acceptance, then change values
Dim i As Long
Dim dateID As Long
Dim offlineRow As Long
Dim bceDate As String
For i = 2 To dateComp.ListRows.Count + 1
If dateComp.ListColumns(6).Range(i).Value = "Yes" Then
dateID = dateComp.ListColumns(1).Range(i).Value
offlineRow = Application.WorksheetFunction.Match(dateID, offlineRange, 0)
bceDate = dateComp.ListRows(i - 1).Range(5).Value
offline.ListRows(offlineRow).Range(12).Value = bceDate
End If
Next i
Call opportunityComp
End Sub
Related
you all were a great help with my last issue, so I figured Id ask another question. I am currently creating a code that keeps track of a mailroom's inventory. The code that I am working on is a textbox that whenever something is typed, it copies the value to the excel and it triggers an advanced search. I want to use xlfiltercopy to prevent visual damage to the excel sheet and so it is easier to update the listbox in the userform with the filtered information. Please let me know if you can find a reason that the error "AdvancedFilter method of Range class failed"
EDIT: If possible, I would like to email the entire excel to someone to see if the program works on another computer. I cannot physically think of a way to get it to work. Please consider it!
' Input on the 2nd page
' This code will update the list box below automatically as you type a name
Private Sub TextBox5_Change()
If Me.TextBox5.Value = "" Then
Exit Sub
End If
Dim wks As Worksheet
Set wks = ThisWorkbook.Sheets("Mail_Inventory")
Dim rgData As Range
Dim rgCriteria As Range
Dim rgOutput As Range
Dim currentinventory As Long
Dim filteredcurrent As Long
Dim temp As Long
temp = wks.Range("AS1").Value
If temp > 0 Then
wks.ListObjects("CurrentFiltered").DataBodyRange.Rows.Delete
End If
wks.Range("AP6").Value = Me.TextBox5.Value
currentinventory = wks.Range("A1").Value
'Set rgData = ThisWorkbook.Worksheets("Mail_Inventory").Range("A2:H" & currentinventory + 2)
'Set rgCriteria = ThisWorkbook.Worksheets("Mail_Inventory").Range("AP5:AP6")
'Set rgOutput = ThisWorkbook.Worksheets("Mail_Inventory").Range("AS2:AZ2")
Set rgData = Range("A2:H" & currentinventory + 2)
Set rgCriteria = Range("AP5:AP6")
Set rgOutput = Range("AS2:AZ2")
rgData.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rgCriteria, CopytoRange:=rgOutput
'wks.Range("A2:H" & currentinventory + 2).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wks.Range("AP5:AP6"), CopyToRange:=wks.Range("AS2:AZ2")
'filteredcurrent = wks.Range("AS1").Value
'Me.ListBox2.Clear
'Me.ListBox2.RowSource = wks.Range("AS2:AV" & filteredcurrent + 2)
I am very new to VBA, having started programming it yesterday. I am writing a data processing program which requires keeping track of two cells, one on each spreadsheet. The code which reproduces the errors I am experiencing is below. When I call the sub moveCell() in sub Processor(), nothing happens to DIRow and DIColumn, and the code spits out error 1004 at the line indicated. I have tried using DICell = DICell.Offset(), but it returns the same error.
How can I redefine a Range variable to be a different cell?
'<<Main Processor Code>>'
Sub Processor()
Dim PDRow As Integer
Dim PDColumn As Integer
Dim DIRow As Integer
Dim DIColumn As Integer
PDRow = 1
PDColumn = 1
DIRow = 1
DIColumn = 1
Dim PDCell As Range
Dim DICell As Range
Set PDCell = Worksheets("Processed Data").Cells(PDRow, PDColumn)
Set DICell = Worksheets("Data Input").Cells(DIRow, DIColumn)
Call moveCell(2, 0, "Data Input")
End Sub
'<<Function which moves the cell which defines the range>>'
Sub moveCell(r As Integer, c As Integer, sheet As String)
If sheet = "Processed Data" Then
PDRow = PDRow + r
PDColumn = PDColumn + c
Set PDCell = Worksheets("Data Input").Cells(PDRow, PDColumn)
ElseIf sheet = "Data Input" Then
DIRow = DIRow + r '<<<<<<This line does nothing to DIRow's value
DIColumn = DIColumn + c
Set DICell = Worksheets("Data Input").Cells(DIRow, DIColumn) '<<<<<<This line causes error 1004
End If
End Sub
As far as I can tell, you could instead use a quick Function instead. There doesn't seem to be any difference in your If statement results in the moveCell() function, except which worksheet you're using.
We can make this simpler by referring to the Range you're passing to moveCell.
Option Explicit ' forces you to declare all variables
Sub something()
Dim PDCell As Range
Set PDCell = Worksheets("Processed Data").Cells(1, 1)
Dim DICell As Range
Set DICell = Worksheets("Data Input").Cells(1, 1)
PDCell.Select ' can remove
Set PDCell = moveCell(2, 0, PDCell, PDCell.Worksheet.Name)
PDCell.Select ' can remove
Worksheets(DICell.Worksheet.Name).Activate ' can remove
DICell.Select ' can remove
Set DICell = moveCell(5, 0, DICell, DICell.Worksheet.Name)
DICell.Select ' can remove
End Sub
Function moveCell(rowsToMove As Long, colsToMove As Long, cel As Range, ws As String) As Range
Set moveCell = Worksheets(ws).Cells(cel.Row + rowsToMove, cel.Column + colsToMove)
End Function
I've included some rows you don't need (which I've marked with a comment afterwards), but that will show you how the routine works. You can step through with F8 to help see it step-by-step.
Edit: Although, you don't need a separate function at all. Just use OFFSET().
Set PDCell = ...whatever originally
Set PDCell = PDCell.Offset([rows],[cols])
I need to classify each row of a range accordingly with another range. The script works just fine. But it takes too much time even if it has no more than 300 rows. E.g. 298 rows take more than 2 minutes.
In order to achieve the classification, the script was built with a for each loop inside another one. All is done in the same worksheet called WSSeg. I tried to use all the good practices that I know of.
Option Explicit
Sub Input_Classification()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim TBLClassification As ListObject
Dim TBLReference As ListObject
Dim rClassificationCell As Range
Dim rClassification As Range
Dim rReferenceCell As Range
Dim rReference As Range
Set TBLClassification = WSSeg.ListObjects("TBClass")
Set rClassification = TBL.ListColumns(4).DataBodyRange
Set TBLReference = WSSeg.ListObjects("TBResumo")
Set rReference = TBL.ListColumns(4).DataBodyRange
For Each rClassificationCell In rClassification
For Each rReferenceCell In rReference
If rClassificationCell.Offset(0, -1).Value <= rReferenceCell.Value Then
rClassificationCell.Value = rReferenceCell.Value
End If
Next rReferenceCell
Next rClassificationCell
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
I expect the run time code to be shorter. I don't know if I have to use another logic system. Thanks in advance.
Tried to modify the code, it takes only 0.04 Secs with two tables of around 500 rows.
Tried to keep the replacement logic same as the original, But may please check the same, as i am little confused about the same. If find otherwise, please modify them to your need. Also Could not understand the what is TBL in cases with both the tables and assumed the obvious.
Option Explicit
Sub Input_Classification()
Dim WSSeg As Worksheet
Dim TBLClassification As ListObject
Dim TBLReference As ListObject
Dim rClassification As Range
Dim SrcArr As Variant, TrgArr As Variant, SrcCel As Variant
Dim i As Long, Tm As Double
Set WSSeg = ThisWorkbook.Sheets("Sheet1")
Tm = Timer
Set TBLClassification = WSSeg.ListObjects("TBClass")
Set rClassification = TBLClassification.ListColumns(3).DataBodyRange.Resize(TBLClassification.DataBodyRange.Rows.Count, 2)
TrgArr = rClassification.Value
Set TBLReference = WSSeg.ListObjects("TBResumo")
SrcArr = TBLReference.ListColumns(4).DataBodyRange.Value
For i = 1 To UBound(TrgArr, 1)
For Each SrcCel In SrcArr
If TrgArr(i, 1) <= SrcCel Then
TrgArr(i, 2) = SrcCel
End If
Next SrcCel
Next i
rClassification.Value = TrgArr
Debug.Print "Seconds taken " & Timer - Tm
End Sub
Since I personally don't prefer to keep calculations, event processing and screen updating off (in normal cases) i haven't added that standard lines. However you may use these standard techniques, depending on the working file condition.
I'm trying to find the rows with data in my source data sheet and then copy some of the columns into various places in my destination worksheet using VBA. I have successfully done this for a list with 12k lines but when I do some test data, it only copies the first 12 rows out of 19 rows of data....
Sub Header_Raw()
Dim dataBook As Workbook
Dim Header_Raw As Worksheet, Header As Worksheet
Dim dataSource As Range, dataDest As Range
Dim sourceDataRowCount As Integer, index As Integer
Set dataBook = Application.ThisWorkbook
Set sheetSource = dataBook.Sheets("Header_Raw")
Set sheetDest = dataBook.Sheets("Header")
Set dataSource = sheetSource.Range("B4", _
sheetSource.Range("J90000").End(xlUp))
sourceDataRowCount = dataSource.Rows.Count
Set dataDest = sheetDest.Range("B13", "B" & _
sourceDataRowCount)
For index = 1 To sourceDataRowCount
dataDest(index, 1).Value = dataSource(index, 1).Value
dataDest(index, 2).Value = dataSource(index, 2).Value
Next index
End Sub
If you can help tell me what I have done wrong, that would be great
thanks
Julie
Make your life a bit easier with simple debugging. Run the following:
Sub HeaderRaw()
'Dim all the variables here
Set dataBook = Application.ThisWorkbook
Set SheetSource = dataBook.Sheets("Header_Raw")
Set sheetDest = dataBook.Sheets("Header")
Set dataSource = SheetSource.Range("B4", SheetSource.Range("J90000").End(xlUp))
SheetSource.Activate
dataSource.Select
End Sub
Now you will see what is your dataSource, as far as it is selected. Probably it is not what you expect.
I have three workbooks; all with information on the same policies, but come from different documents. I'm trying to copy the value of the same cell from each worksheet that has the same worksheet name in workbooks 1 & workbook 3. This is the code that I have:
Sub foo()
Dim wbk1 As Workbook
Dim wbk2 As Workbook
Dim wkb3 As Workbook
Dim shtName As String
Dim i As Integer
Set wkb1 = Workbooks.Open("C:\Users\lliao\Documents\Trad Reconciliation.xlsx")
Set wkb2 = Workbooks.Open("C:\Users\lliao\Documents\TradReconciliation.xlsx")
Set wkb3 = Workbooks.Open("C:\Users\lliao\Documents\Measure Trad Recon LS.xlsx")
shtName = wkb2.Worksheets(i).Name
For i = 2 To wkb2.Worksheets.Count
wkb2.Sheets(shtName).Range("D3").Value = wkb1.Sheets(shtName).Range("D2")
wkb2.Sheets(shtName).Range("E3").Value = wkb1.Sheets(shtName).Range("E2")
wkb2.Sheets(shtName).Range("F3").Value = wkb1.Sheets(shtName).Range("F2")
wkb2.Sheets(shtName).Range("D4").Value = wkb3.Sheets(shtName).Range("D2")
wkb2.Sheets(shtName).Range("E4").Value = wkb3.Sheets(shtName).Range("E2")
wkb2.Sheets(shtName).Range("F4").Value = wkb3.Sheets(shtName).Range("F2")
Next i
End Sub
I don't understand how I'm using the subscript wrong. This is my first time coding VBA (first time in 5+ years), so I'm unfamiliar with coding errors.
Thank you!
Dim i As Integer
Set wkb1 = Workbooks.Open("C:\Users\lliao\Documents\Trad Reconciliation.xlsx")
Set wkb2 = Workbooks.Open("C:\Users\lliao\Documents\TradReconciliation.xlsx")
Set wkb3 = Workbooks.Open("C:\Users\lliao\Documents\Measure Trad Recon LS.xlsx")
shtName = wkb2.Worksheets(i).Name
Variable i is declared, but used before it's assigned - its value is therefore an implicit 0.
With VBA collections being 1-based, that makes wkb2.Worksheets(i) be out of bounds.
Dim i As Integer
i = 1
'...
shtName = wkb2.Worksheets(i).Name
Will fix it.
You probably want to move it inside the loop though.
may be you're after this:
For i = 2 To wkb2.Worksheets.Count
wkb2.Sheets(i).Range("D3:F3").Value = wkb1.Sheets(i).Range("D2:F2")
wkb2.Sheets(i).Range("D4:F4").Value = wkb3.Sheets(i).Range("D2:F2")
Next i