I keep on getting an "object variable not set" error with this code. I want to offset the startcell cell address to take the average of a corresponding column. However, vba tries to offset the value of the startcell, rather than the cell address. It would be great if someone can offer me some guidance. Thanks!
Sub Macro1()
Dim i As Integer
Dim rowcount As Integer
Dim startcell As Range
startcell = ActiveSheet.Cells(2, 3).Address(False, False)
rowcount = Range("C2", Range("C2").End(xlDown)).Count
For i = 1 To rowcount
If Not Cells(i, 3).Value = Cells(i + 1, 3).Value Then
startcell.Offset(0, 11).Value = Application.WorksheetFunction.Average( _
Range(startcell.Offset(0, 8), Cells(i, 11)))
startcell = ActiveSheet.Cells(i + 1, 3).Address(False, False)
End If
Next i
End Sub
To save a given range in a variable, you either use its address, which is a string, or a Range object. The latter is usually preferred, and it looks like this was you intent.
Dim startcell As Range
....
Set startcell = ActiveSheet.Cells(2, 3) ' <-- Set a range object variable
....
Set startcell = ActiveSheet.Cells(i + 1, 3) ' <-- Set
On the other hand if you want to use the address (less recommended unless there are specific reasons):
Dim startAddr As String ' <--
....
startAddr = ActiveSheet.Cells(2, 3).Address(False, False) ' <-- ok, save address
....
Range(startAddr).Offset(0, 11).Value = ... ' Range(startAddr) reconstructs a range from the address
startAddr = ActiveSheet.Cells(i + 1, 3).Address(False, False)
Related
I have a function that checks the rows underneath the current one depending on the unique ID. There can be up to 6 unique ideas under the current record (loop variable = i) that match the current record being checked in the loop. After this is done, the records underneath are checked for specific conditions (loop variable x). However, for some reason, I'm running into several issues. The first is that I had to set the range references inside of both loops, otherwise I got an error. The second is that, all of the stuff after the x loop seems to be outputting in the i loop that came before it. What am I doing wrong, and how can i make this function properly?
Please find my code below:
Function First_check()
dim i as long, x as long
Dim numComponents As Variant
Dim in1 As Range, in2 As Range, in3 As Range, in4 As Range, in5 As Range, _
in6 As Range, in7 As Range, in8 As Range, in9 As Range, in10 As Range, _
in11 As Range, in12 As Range, in13 As Range, in14 As Range, in15 As Range, _
in16 As Range, in17 As Range, in18 As Range, in19 As Range, in20 As Range
Dim out1 As Range, out2 As Range, out3 As Range, out4 As Range, out5 As Range, _
out6 As Range, out7 As Range, out8 As Range, out9 As Range, out10 As Range, _
out11 As Range, out12 As Range, out13 As Range, out14 As Range, out15 As Range, _
out16 As Range, out17 As Range, out18 As Range, out19 As Range, out20 As Range
Dim str, msg, oft, BTG, LOB, pdf, mht, emails, zip_rar, xls, doc, xls_doc, mrTT, lobVal, cmt1, giveURL, giveURLm As String
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
For i = 2 To lastRow
If Cells(i, 5).Value2 = Cells(i + 6, 5).Value2 Then
numComponents = 6
ElseIf Cells(i, 5).Value2 = Cells(i + 5, 5).Value2 Then
numComponents = 5
ElseIf Cells(i, 5).Value2 = Cells(i + 4, 5).Value2 Then
numComponents = 4
ElseIf Cells(i, 5).Value2 = Cells(i + 3, 5).Value2 Then
numComponents = 3
ElseIf Cells(i, 5).Value2 = Cells(i + 2, 5).Value2 Then
numComponents = 2
ElseIf Cells(i, 5).Value2 = Cells(i + 1, 5).Value2 Then
numComponents = 1
Else
numComponents = 0
End If
For x = i + 1 To i + numComponents
Set in1 = Cells(i, 11) 'test
Set in2 = Cells(i, 12)
Set in3 = Cells(i, 13)
Set in4 = Cells(i, 16) 'e
Set in5 = Cells(i, 37) 'target date
Set in6 = Cells(i, 38) 'target date end
Set in7 = Cells(i, 35) 'target date actual
Set in8 = Cells(i, 37) 'target date start
Set in9 = Cells(i, 38) 'target date end
Set in10 = Cells(x, 50) ' date start
Set in11 = Cells(x, 51) ' date end
Set in12 = Cells(i, 42) 'pro
Set in13 = Cells(i, 43) 'reco
Set in14 = Cells(x, 62) 'cert
Set in15 = Cells(x, 63) 'com
Set in16 = Cells(x, 64) 'comp
Set in17 = Cells(x, 49) 'uniqueID
'outs
Set out1 = Cells(i, 72) 'test
Set out2 = Cells(i, 73) '
Set out3 = Cells(i, 74) '
Set out4 = Cells(i, 75) 'e
Set out5 = Cells(i, 76) 'tar
Set out6 = Cells(i, 77) 'comp
Set out7 = Cells(i, 78) 'pro
Set out8 = Cells(i, 75) 'empty
Set out9 = Cells(i, 80) 'cer
Set out10 = Cells(i, 81) 'comp
Set out11 = Cells(i, 85) 'pre
Set out12 = Cells(i, 88) 'missing
Set out13 = Cells(i, 89) 'missing2
Set out14 = Cells(i, 71) 'uniqueID
'------ATTACHMENT SET
str = Cells(i, 46).Value2
msg = UBound(Split(str, ".msg"))
oft = UBound(Split(str, ".oft"))
BTG = UBound(Split(str, "BTG"))
LOB = UBound(Split(str, "LOB"))
pdf = UBound(Split(str, ".pdf"))
mht = UBound(Split(str, ".mht"))
emails = msg + oft + pdf + mht
zip_rar = UBound(Split(str, ".zip"))
xls = UBound(Split(str, ".xls"))
doc = UBound(Split(str, ".doc"))
xls_doc = xls Or doc
If (in8.Value2 <> in10.Value2) Or (in9.Value <> in11.Value2) Then 'date
out6.Value2 = Cells(x, 49).Value2 & ", " & out6.Value2
End If
If IsBlank(in14.Value2) Then 'Check cer
out9.Value2 = Cells(x, 49).Value2 & ", " & out9.Value2
End If
If IsBlank(in15.Value2) Or IsBlank(in16.Value2) Then 'check loc
out10.Value2 = Cells(x, 49).Value2 & ", " & out10.Value2
End If
If Not IsBlank(in17.Value2) Then
out14.Value2 = in17.Value2 & ", " & out14.Value2
End If
Next x
If Not IsBlank(out6.Value2) Then 'date
out6.Value2 = "Wrong dates"
out6.Value2 = fixtrail(out6.Value2)
End If
If Not IsBlank(out9.Value2) Then 'cert
out9.Value2 = "Cert Issue"
out9.Value2 = fixtrail(out9.Value2)
End If
If Not IsBlank(out10.Value2) Then 'comp
out10.Value2 = "Comp not found"
out10.Value2 = fixtrail(out10.Value2)
End If
If IsBlank(in1.Value2) Then
out1.Value2 = "Missing type"
End If
'
'many more checks happening that i omittied for brevity
'
If numComponents = 0 Then
Cells(i, 70).Value2 = "0"
Else
Cells(i, 70).Value2 = numComponents
End If
i = i + numComponents
Next i
End Function
The first idea that came to mind is using an array of Range objects to clean up the variable declarations:
Dim inRange(20) As Range
Dim outRange(20) As Range
'...
For x = i + 1 To i + numComponents
Set inRange(1) = Cells(i, 11)
Set inRange(2) = Cells(i, 12)
'...
Next
This will work especially well if you can get a formula for the cell numbers that map to each array position.
Additionally, we can improve variables around how the two loops are nested. The outer loop uses the i variable, while the inner loop uses the x variable. Since these are both looking at rows, I would re-name them as r0 and r1 (or rBase and rNested, rParent and rChild, rMaster and rDetail, etc) to help you understand what you're looking at with each index. I also see that some of the Range objects depend on the current i value, while other depend on x. You should be able to assign the i ranges above the inner loop, and save some CPU/memory work that way:
For irParent = 2 To LastRow
'...
Set inRange(1) = Cells(irParent, 11) 'test
Set inRange(2) = Cells(irParent, 12)
Set inRange(3) = Cells(irParent, 13)
Set inRange(4) = Cells(irParent, 16) 'e
'...
'If numComponents is 0, there are no child rows and this loop is skipped
For rChild = rParent + 1 To rParent + numComponents
Set inRange(10) = Cells(irChild, 50) ' date start
Set inRange(11) = Cells(irChild, 51) ' date end
'...
str = Cells(irParent, 46).Value2
msg = UBound(Split(str, ".msg"))
oft = UBound(Split(str, ".oft"))
'...
Next
irParent = irParent + numComponents
Next
Another thing is this method runs kind of long. You may want to abstract out some of the checks to a separate method, or a few separate methods that depend on what type of parent record you're looking at. Create methods that just accept the values needed for checking a particular kind of row, and then returns a single result for the check. This adds names to the code that help you understand what you're doing, as well as shorting the parent code to make it easier to read and understand at a high level more quickly.
As you make those other changes, you may want to start thinking in terms of creating Range objects that represent an entire row (or section from a row), so you can pass them to methods. This is especially true, as it appears many Range objects are currently used to hold values from single Cells. You can build strings to define non-contiguous Ranges that have the values needed for each row (including the parent cells when working in a child row). This will make building functions much easier, if you can have them simply accept a single Range object that you know has the correct cells in it.
This is also helpful because it minimizes instances where you copy from Excel Cells to memory. Moving data between VBA and Excel is a costly operation. It's usually better for performance to copy to or from a set of Cells in bulk, rather than one Cell at a time. This often holds even when it means using some extra memory. It also often helps reduce or simplify the total amount of code needed. Unfortunately, I'm too far out of VBA to show you an example.
Finally, notice my indentation. Professionals will do that consistently... even religiously. "Hacky" code does not. It's extremely helpful for spotting mistakes.
I'm currently trying to make a map that transposes unique values from a column and populate this new list with some parameters from another table,
the result on this map should be the following
I've already have the code for the unique values as follows:
Dim d As Object
Dim c As Variant
Dim i As Long
Dim lr As Long
Set d = CreateObject("Scripting.Dictionary")
lr = Cells(Rows.Count, 9).End(xlUp).Row
c = Range("B2:B" & lr)
For i = 1 To UBound(c, 1)
d(c(i, 1)) = 1
Next i
Range("AK2").Resize(d.Count) = Application.Transpose(d.keys)
Although for filling the amounts on the columns Base and VAT I'm having some issues trying to think on the formula, basically for "Base" the value should be the total by Document Nr of the accounts starting with 6*,7* which are a result of Dr - Cr.
I know it may sound a bit confusing, but if anyone could please help me I would be much appreciated.
Using #RonRosenfeld formula from comments, following might be helpful:
Sub Demo()
Dim lastRow As Long, lastCol As Long, currLR As Long
Dim rng As Range, rngWH As Range
Dim srcSht As Worksheet
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set srcSht = Sheets("Sheet1") 'set data sheet here
With srcSht
lastRow = .Range("A" & .Rows.Count).End(xlUp).Row 'last row with data in sheet
Set rng = .Range("A1:A" & lastRow) 'range for filter
Set rngWH = .Range("A2:A" & lastRow) 'range for formulas
lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column + 2 'column to display data
rng.AdvancedFilter Action:=xlFilterCopy, copytoRange:=.Cells(1, lastCol), unique:=True
currLR = .Cells(.Rows.Count, lastCol).End(xlUp).Row 'unique nr. doc count
lastCol = lastCol + 1
'formula for Base
.Cells(1, lastCol).Value = "Base"
.Range(.Cells(2, lastCol), .Cells(currLR, lastCol)).Formula = _
"=SUMPRODUCT((" & .Cells(2, lastCol - 1).Address(False, False) & "=" & rngWH.Address & ")*(LEFT(" & rngWH.Offset(, 1).Address & ")={""6"",""7""})*(" & rngWH.Offset(, 2).Address & "))"
'formula for Vat
.Cells(1, lastCol + 1).Value = "VAT"
'enter formula here for VAT
'formula for Total
.Cells(1, lastCol + 2).Value = "Total"
.Range(.Cells(2, lastCol + 2), .Cells(currLR, lastCol + 2)).Formula = _
"=SUMIF(" & rngWH.Address & "," & .Cells(2, lastCol - 1).Address(False, False) & "," & rngWH.Offset(, 3).Address & ")"
.Range(.Cells(2, lastCol), .Cells(currLR, lastCol + 2)).Value = .Range(.Cells(2, lastCol), .Cells(currLR, lastCol + 2)).Value
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
For a "pure" VBA solution, I would
create a user defined object which as the properties of Nr.Doc, Acct, VAT, Base and Total.
Base, as you wrote, we detect by checking the first digit of the account
VAT will be any amount in the Dr column that does not start with 6 or 7
Total will be the values in the Cr column.
If your rules are different, by setting things up like this, they can be easily changed, as the code is almost self-documenting.
For the UDO, we enter a class module and rename it cDoc.
Also, I chose to use early-binding so we set a reference to Microsoft Scripting Runtime. If you want to change it to late-binding as you do in your posted code, feel free to do that. It can be easier if you are distributing the file; but I prefer to have the Intellisense available when I am coding.
Class Module
Option Explicit
'Rename this module "cDoc"
Private pDocNum As String
Private pAcct As String
Private pBase As Currency
Private pVAT As Currency
Private pTotal As Currency
Public Property Get Acct() As String
Acct = pAcct
End Property
Public Property Let Acct(Value As String)
pAcct = Value
End Property
Public Property Get Base() As Currency
Base = pBase
End Property
Public Property Let Base(Value As Currency)
pBase = Value
End Property
Public Property Get VAT() As Currency
VAT = pVAT
End Property
Public Property Let VAT(Value As Currency)
pVAT = Value
End Property
Public Property Get Total() As Currency
Total = pTotal
End Property
Public Property Let Total(Value As Currency)
pTotal = Value
End Property
Public Property Get DocNum() As String
DocNum = pDocNum
End Property
Public Property Let DocNum(Value As String)
pDocNum = Value
End Property
Regular Module
Option Explicit
'Set Reference to Microsoft Scripting Runtime
' you can change this to late binding if everything works
Sub ReOrganizeTable()
Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range
Dim vSrc As Variant, vRes As Variant
Dim dDoc As Dictionary, cD As cDoc
Dim I As Long
Dim V As Variant
'Set source and results worksheets
'Read source data into variant array
Set wsSrc = Worksheets("sheet1")
With wsSrc
vSrc = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(columnsize:=4)
End With
On Error Resume Next
Set wsRes = Worksheets("Results")
Select Case Err.Number
Case 9
Set wsRes = Worksheets.Add(after:=wsSrc)
wsRes.Name = "Results"
Case Is <> 0
Debug.Print Err.Number, Err.Description
Stop
End Select
On Error GoTo 0
Set rRes = wsRes.Cells(1, 1)
'Gather and organize the data
Set dDoc = New Dictionary
For I = 2 To UBound(vSrc, 1)
Set cD = New cDoc
With cD
.DocNum = vSrc(I, 1)
.Acct = CStr(vSrc(I, 2))
Select Case Left(.Acct, 1)
Case 6, 7
.Base = vSrc(I, 3)
Case Else
.VAT = vSrc(I, 3)
End Select
.Total = vSrc(I, 4)
If Not dDoc.Exists(.DocNum) Then
dDoc.Add Key:=.DocNum, Item:=cD
Else
dDoc(.DocNum).Base = dDoc(.DocNum).Base + .Base
dDoc(.DocNum).VAT = dDoc(.DocNum).VAT + .VAT
dDoc(.DocNum).Total = dDoc(.DocNum).Total + .Total
End If
End With
Next I
'Size results array
ReDim vRes(0 To dDoc.Count, 1 To 4)
'Headers
vRes(0, 1) = "Nr Doc"
vRes(0, 2) = "Base"
vRes(0, 3) = "VAT"
vRes(0, 4) = "Total"
'Populate the data area
I = 0
For Each V In dDoc.Keys
I = I + 1
Set cD = dDoc(V)
With cD
vRes(I, 1) = .DocNum
vRes(I, 2) = .Base
vRes(I, 3) = .VAT
vRes(I, 4) = .Total
End With
Next V
'write and format the results
Set rRes = rRes.Resize(UBound(vRes, 1) + 1, UBound(vRes, 2))
With rRes
.EntireColumn.Clear
.Value = vRes
With .Rows(1)
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
.EntireColumn.AutoFit
End With
End Sub
Results
Using your original posted data
I prefer to use the function .value, because i dont miss anything, but i cant to paste or the all range
Anyone know how i can do?
Sub AUTO()
Application.ScreenUpdating = False
'sheet that i want paste
PasteData1 = ActiveSheet.Cells(3, 6).Value
DATAAUTO = "L:\ANALISTA_M\Frade\FINANCIAL SERVICES\INSURANCE\Mercado\SUSEP\Planilhas\Auto-Susep.xlsx"
Workbooks.Open (DATAAUTO)
sName = ActiveSheet.Name
'count the number of rows and columns
i = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row - 11
c = ActiveSheet.Cells(6, Columns.Count).End(xlToLeft).Column
'select all range that i want
COPYDATE = ActiveSheet.Range(Cells(6, 1), Cells(i, c)).Value
PASTEAUTO = "L:\ANALISTA_M\Frade\FINANCIAL SERVICES\INSURANCE\Mercado\SUSEP\Auto.xlsm"
Workbooks.Open (PASTEAUTO)
Worksheets(PasteData1).Activate
'the problem is here!!! i need to respect a order the beging my paste
ActiveSheet.Cells(2, 2).Value = COPYDATE
ActiveSheet.Range(Cells(2, 2), Cells(i - 4, c + 1)).Replace What:=".", Replacement:=""
ActiveSheet.Range(Cells(2, 2), Cells(i - 4, c + 1)).Replace What:=",", Replacement:="."
Worksheets("Consolidado").Activate
Workbooks("Auto-Susep.xlsx").Close
Application.ScreenUpdating = True
End Sub
to use the .Value over copy paste you need to have the same size range. You have one cell trying to hold a 2 dimensional array.
So change:
ActiveSheet.Cells(2, 2).Value = COPYDATE
to:
ActiveSheet.Cells(2, 2).Resize(UBound(COPYDATE,1),UBound(COPYDATE,2)).Value = COPYDATE
Also I do not see where you declare any of your variables, that is a bad habit, one should always declare their variables even if they are of a Variant type.
Dim COPYDATE() as Variant
I am looking to calculate a column (in wsOut) of averages using VBA. The input is in another sheet (wsRefor).
I use the following code, where I use the worksheet function to calculate the average
Dim Avg As Double
Dim AvgRange As Range
Set Reformulering = ActiveSheet
For i = 1 To lastCol
AvgRange = Range(wsRefor.Cells(1 + i, 4), wsRefor.Cells(1 + i, lastCol))
wsOut.Cells(i + 1, 4).Value = Application.WorksheetFunction.Average(AvgRange)
Next
Yet, I get the mistake, from the second line inside of the for-loop:
"Object variable or With block variable not set"
I am not sure I understand the error from videos I have watched and other forum discussion, so I am hoping anyone can explain or potentially point of the mistake
You need to use the Set keyword when you are assigning an object rather than a value.
A Range is an object and so it needs to be Set
Set AvgRange = Range(wsRefor.Cells(1 + i, 4), wsRefor.Cells(1 + i, lastCol))
To see the difference, you can do this:
Dim test As Variant
Range("A1").Value = "some text"
test = Range("A1") '// test is now a string containing "some text"
Set test = Range("A1") '// test is now a range object
MsgBox test.Value '// Displays the value of the range object "some text"
Assuming you defined Dim wsRefor As Worksheet, and set it to the right Sheet, then modify your line:
AvgRange = Range(wsRefor.Cells(1 + i, 4), wsRefor.Cells(1 + i, lastCol))
to:
Set AvgRange = wsRefor.Range(Cells(1 + i, 4), Cells(1 + i, lastCol))
or, on the safe side:
With wsRefor
Set AvgRange = .Range(.Cells(1 + i, 4), .Cells(1 + i, lastCol))
End With
Edit 1: full code which I've tested (also has error handling for the Average Function)
Option Explicit
Sub DynamicAvgRange()
Dim wsRefor As Worksheet
Dim wsOut As Worksheet
Dim Avg As Double
Dim AvgRange As Range
Dim lastCol As Long
Dim i As Long
Set wsRefor = ThisWorkbook.Sheets("Refor")
Set wsOut = ThisWorkbook.Sheets("Out")
' just for simulating the tests
lastCol = 6
For i = 1 To lastCol
With wsRefor
Set AvgRange = .Range(.Cells(1 + i, 4), .Cells(1 + i, lastCol))
End With
If Not IsError(Application.Average(AvgRange)) Then
wsOut.Cells(i + 1, 4).Value = Application.Average(AvgRange)
Else
' Average value returned an error (no values in the searched range)
wsOut.Cells(i + 1, 4).Value = "" ' put a blank value >> modify to your needs
End If
Next i
End Sub
ANY IDEA ??? I don't know why there's a type error especially that i've changed the type of both cells
Cells(i, 7).NumberFormat = "#"
Workbooks("template.xls").Worksheets("Introduction").Cells(j, 21).NumberFormat = "#"
If Left(Cells(i, 7), 13) = Workbooks("template.xls").Worksheets("Introduction").Cells(j, 21).Value
.
.
.
Code from comments:
Dim i As Long
Dim j As Integer
For j = 5 To derlig
For i = 2 To 4000
Cells(i, 2).NumberFormat = "#"
Workbooks("template.xls").Worksheets("Introduction").Cells(j, 21).NumberFormat = "#"
Workbooks("Cat export.xls").Worksheets("Items").Activate
If Left(Cells(i, 2), 13).Value = Workbooks("template.xls").Worksheets("Introduction").Cells(j, 21).Value Then
Workbooks("Cat export.xls").Worksheets("Items").Cells(i, 3) = Right(Workbooks("Cat export.xls").Worksheets("Items").Cells(i, 2), 5)
End If
Next
Next
The error is happening because you are not qualify all of your objects, so if any workbook or worksheet is active other than what you may expect, the code may not perform correctly.
It's best practice to always qualify objects in VBA and work directly with them.
See below:
Dim wbMyWB as Workbook, wbTemplate as Workbook
Set wbMyWB = Workbooks("myWB.xlsx") 'change as needed
Set wbTemplate = Workbooks("template.xls")
Dim wsMyWS as Worksheet, wsIntro as Worksheet
Set wsMyWS = wbMyWB.Worksheets("Sheet1") ' change as needed
Set wsIntro = wbTemplate.Worksheets("introduction")
'....
Dim rMyRange as Range, rIntro as Range
'assumes i and j are properly set to long or integer (or variant (hopefully not) type
'ideally i and j are both set to integer
rMyRange = wsMyWs.Cells(i,7)
rIntro = wsIntro.Cells(j,21)
rMyRange.NumberFormat = "#"
rIntro.NumberFormat = "#"
If Left(rMyRange,13).Value = rIntro.Value Then
'condition satisfied
End If