I want to sum rows from column I to T and display the result in column V.
Currently, my code is:
Sub Sum_column_V()
Dim lastRow As Long, i As Integer, totalItoT As Double, sht As Worksheet
Set sht = ThisWorkbook.Worksheets("Summary")
lastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
For i = 1 To lastRow
totalItoT = WorksheetFunction.Sum(Range("I" & i & "T" & i))
Next
sht.Range("V" & i) = totalItoT
End Sub
I get the error message: "Run-time error '1004': Method 'Range' of object' Global failed"
What am I doing wrong?
The initial macro with Nathan_Sav's correction made the code work. However, used a different approach to optimize running time. Here it is:
Sub Sum_column_V()
Sheets("Summary").Select
Dim j As Integer
j = 2
While Cells(j, 1) <> ""
Cells(j, 22) = Application.Sum(Range(Cells(j, 9), Cells(j, 20)))
j = j + 1
Wend
End Sub
Related
I'm writing an excel VBA script to loop through a set of 4 sheets, find a string at the top of a column of data, loop through all the data in that column and print the header and data in a summary tab.
I'm new to VBA and even after extensive research can't figure out why I'm getting Runtime error 1004 "Application-defined or object-defined error."
Here is the VBA code:
Private Sub CommandButton1_Click()
Dim HeaderList(1 To 4) As String, sheet As Worksheet, i As Integer, j As Integer, Summary As Worksheet
'Define headers to look for
HeaderList(1) = "Bananas"
HeaderList(2) = "Puppies"
HeaderList(3) = "Tigers"
'Loop through each sheet looking for the right header
For Each sheet In Workbooks("Tab Extraction Test.xlsm").Worksheets
i = i + 1
'Debug.Print i
'Debug.Print HeaderList(i)
Set h = Cells.Find(What:=HeaderList(i))
With Worksheets("Summary")
Worksheets("Summary").Cells(1, i).Value = h
End With
Col = h.Column
Debug.Print Col
Row = h.Row
Debug.Print Row
j = Row
'Until an empty cell in encountered copy the value to a summary tab
Do While IsEmpty(Cells(Col, j)) = False
j = j + 1
V = Range(Col, j).Value
Debug.Print V
Workbooks("Tab Extraction Test.xlsm").Worksheets("Summary").Cells(j, i).Value = V
Loop
Next sheet
End Sub
The error occurs at
Worksheets("Summary").Cells(1, i).Value = h
From other posts I thought this might be because I was trying to add something to a different cell than the one that was active in the current loop so I added a With statement but to no avail.
Thank you in advance for your help.
Following the comments above, try the code below.
Note: I think your Cells(Row, Col) is mixed-up, I haven't modified it yet in my answer below. I think Cells(Col, j) should be Cells(j, Col) , no ?
Code
Option Explicit
Private Sub CommandButton1_Click()
Dim HeaderList(1 To 4) As String, ws As Worksheet, i As Long, j As Long, Summary As Worksheet
Dim h As Range, Col As Long
'Define headers to look for
HeaderList(1) = "Bananas"
HeaderList(2) = "Puppies"
HeaderList(3) = "Tigers"
' set the "Summary" tab worksheet
Set Summary = Workbooks("Tab Extraction Test.xlsm").Worksheets("Summary")
'Loop through each sheet looking for the right header
For Each ws In Workbooks("Tab Extraction Test.xlsm").Worksheets
With ws
i = i + 1
Set h = .Cells.Find(What:=HeaderList(i))
If Not h Is Nothing Then ' successful find
Summary.Cells(1, i).Value = h.Value
j = h.Row
'Until an empty cell in encountered copy the value to "Summary" tab
' Do While Not IsEmpty(.Cells(h.Column, j))
Do While Not IsEmpty(.Cells(j, h.Column)) ' <-- should be
j = j + 1
Summary.Cells(j, i).Value = .Cells(j, h.Column).Value
Loop
Set h = Nothing ' reset range object
End If
End With
Next ws
End Sub
Try this one.
Private Sub CommandButton1_Click()
Dim HeaderList As Variant, ws As Worksheet, i As Integer, j As Integer, Summary As Worksheet
Dim lastRow As Long, lastCol As Long, colNum As Long
HeaderList = Array("Bananas", "Puppies", "Tigers", "Lions")
For Each ws In Workbooks("Tab Extraction Test.xlsm").Worksheets
lastCol = ws.Range("IV1").End(xlToLeft).Column
For k = 1 To lastCol
For i = 0 To 3
Set h = ws.Range(Chr(k + 64) & "1").Find(What:=HeaderList(i))
If Not h Is Nothing Then
lastRow = ws.Range(Chr(h.Column + 64) & "65536").End(xlUp).Row
colNum = colNum + 1
' The below line of code adds a header to summary page (row 1) showing which workbook and sheet the data came from
' If you want to use it then make sure you change the end of the follpowing line of code from "1" to "2"
' ThisWorkbook.Worksheets("Summary").Range(Chr(colNum + 64) & "1").Value = Left(ws.Parent.Name, Len(ws.Parent.Name) - 5) & ", " & ws.Name
ws.Range(Chr(h.Column + 64) & "1:" & Chr(h.Column + 64) & lastRow).Copy Destination:=ThisWorkbook.Worksheets("Summary").Range(Chr(colNum + 64) & "1")
Exit For
End If
Next i
Next k
Next ws
End Sub
Sometimes you have to remove blank sheets. Say you have 2k sheets because you combined a bunch of txt files into one workbook. But they're all in one column. So you loop through to do a text2columns. It does some of them but not all of them. It stops to give you run-time error 1004. Try removing blank sheets before looping through to do text2columns or something else.
Sub RemoveBlankSheets_ActiveWorkbook()
'PURPOSE: Delete any blanks sheets in the active workbook
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault
Dim sht As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each sht In ActiveWorkbook.Worksheets
If WorksheetFunction.CountA(sht.Cells) = 0 And _
ActiveWorkbook.Sheets.Count > 1 Then sht.Delete
Next sht
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
I am trying to loop the value for column E so that I can use it to VLookup on another worksheet and return the value to column F.
It has been giving me the error
of Application-defined or object-defined error
on the line:
result = Application.WorksheetFunction.VLookup(look, Sheet2.Range("B:H"), 2,
False)
My Code
Dim X As Integer
Dim look As Variant
Dim result As Variant
X = 2
Sheet3.Range("E2").Select
Do Until IsEmpty(ActiveCell)
look = Sheet3.Cells(X, 5).Value
ActiveCell.Offset(1, 0).Select
result = Application.WorksheetFunction.VLookup(look, Sheet2.Range("B:H"), 2, False)
Sheet3.Cells(X, 6).Value = result
X = X + 1
Loop
Try the code below (without using Select, and ActiveCell) :
Option Explicit
Sub VLookupHandleNA()
Dim X As Long
Dim Look As Variant
Dim Result As Variant
X = 2
With Sheet3
Do Until IsEmpty(.Range("E" & X).Value)
Look = .Range("E" & X).Value
Result = Application.VLookup(Look, Sheet2.Range("B:H"), 2, False)
If Not IsError(Result) Then
.Range("F" & X).Value = Result
Else ' if Vlookup returns an error, just write something in the cell to let the user know
.Range("F" & X).Value = "VLookup wasn't able to find " & Look
End If
X = X + 1
Loop
End With
End Sub
I have a bit of code I've written and I'm having trouble with a certain line (Countifs statement). I haven't ever used this in VBA before so I think it might be something to do with Syntax? Please could someone take a look and let me know?
Thanks very much!
Sub TradeCopy()
'Declare Variables
Dim x As Worksheet
Dim y As Worksheet
Dim z As Range
Dim FirstRow As Integer
Dim LastRow As Long
Dim i As Long
Dim j As Long
Dim s As String
Dim t As String
Dim count As Long
Dim startdate As Long
On Error GoTo ERROREND
Application.DisplayAlerts = False
Application.EnableEvents = False
'Setting Values
s = ActiveWorkbook.Sheets("Name Creator").Range("B4")
Set x = ActiveWorkbook.Sheets(s)
t = ActiveWorkbook.Sheets("Name Creator").Range("B5")
Set y = ActiveWorkbook.Sheets(t)
startdate = ActiveWorkbook.Sheets("Name Creator").Range("B3")
'Find Cell where name occurs
Set z = x.Columns("A").Find(what:="trade id", LookIn:=xlValues, Lookat:=xlWhole)
'Return Start Row number
FirstRow = z.Row + 1
'Return Last Row number
LastRow = x.Range("A" & Rows.count).End(xlUp).Row
'Clear Existing Range of Values
y.Rows(2 & ":" & Rows.count).ClearContents
Below is the code giving problems, specifically the "count = " line when running debugger.
'Loop to highlight cells based on conditions
For i = FirstRow To LastRow
count = Application.WorksheetFunction.CountIfs(x.Range("B:B"), x.Range(i, 2), x.Range("L:L"), "<" & startdate)
Rest of code:
If (x.Cells(i, 21) = "Fra" Or x.Cells(i, 21) = "Swap" Or x.Cells(i, 21) = "Swaption" Or x.Cells(i, 21) = "BondOption" Or x.Cells(i, 21) = "CapFloor") And DateValue(x.Cells(i, 12).Value) > startdate And count <= 0 Then
x.Rows.Range("A" & i).Value.Interior.Color = vbRed
End If
Next i
'Loop to check for all 0 Cells and paste values
For j = FirstRow To LastRow
If x.Cells(j, 1).Interior.Color = vbRed Then
x.Rows.Range("A" & j).Value = y.Rows.Range("A" & j).Value
End If
Next j
'Remove Duplicates
y.Columns(2).RemoveDuplicates Columns:=Array(1)
Application.DisplayAlerts = True
Application.EnableEvents = True
MsgBox ("All Done!")
Exit Sub
ERROREND:
MsgBox ("Unexpected Error - Please Seek Assistance or Debug Code")
End Sub
I think you need to change .Range to .Cells in below:
count = Application.WorksheetFunction.CountIfs(x.Range("B:B"), x.Range(i, 2), x.Range("L:L"), "<" & startdate)
To:
count = Application.WorksheetFunction.CountIfs(x.Range("B:B"), x.Cells(i, 2), x.Range("L:L"), "<" & startdate)
I want to copy data from one sheet to another with few conditions:
1. Start with row 1 and column 1 and match if the R1 C2 is not empty then copy the pair R1 C1 and R1 C2 and paste into the other sheet as a new row.
increment the counter for column and match R1 C1 with R1 C3 and so on.
increment the Row when the column counter reaches 10.
I tried the below code but gives compile error as Sub or function not defined.
Please help.
Private Sub CommandButton1_Click()
Dim x As Integer
Dim y As Integer
x = 2
y = 2
Do While Cells(x, 1) <> ""
If Cells(x, y) <> "" Then
Worksheets("Sheet1").Cells(x, 2).Copy
Worksheets("Sheet2").Activate
erow = Sheet2.Cells(Rows.Count, 1).End(xlUp) > Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Sheet2").Rows(erow)
End If
Worksheets("Sheet1").Activate
y = y + 1
If y = 10 Then x = x + 1
End If
Loop
End Sub
You are geting that error because of > in Sheet2.Cells(Rows.Count, 1).End(xlUp) > Offset(1, 0).Row
Avoid the use of using Integer when you are working with rows. Post excel2007, the row count has increased and the Integer may not be able to handle the row number.
Avoid the use of .Activate.
Is this what you are trying? (Untested)
Note: I am demonstrating and hence I am working with the excel cells directly. But in reality, I would be using autofilter & arrays to perform this operation.
Private Sub CommandButton1_Click()
Dim wsInput As Worksheet, wsOutput As Worksheet
Dim lRowInput As Long, lRowOutput As Long
Dim i As Long, j As Long
Set wsInput = ThisWorkbook.Worksheets("Sheet1")
Set wsOutput = ThisWorkbook.Worksheets("Sheet2")
With wsInput
lRowInput = .Range("A" & .Rows.Count).End(xlUp).Row
For i = 2 To lRowInput
If .Cells(i, 2).Value <> "" Then
For j = 3 To 10
lRowOutput = wsOutput.Range("A" & wsOutput.Rows.Count).End(xlUp).Row + 1
.Range(.Range(.Cells(i, 1), .Cells(i, 1)).Address & _
"," & _
.Range(.Cells(i, j), .Cells(i, j)).Address).Copy _
wsOutput.Range("A" & lRowOutput)
Next j
End If
Next i
End With
End Sub
I have a macro which looks at a range of cells. Every other cell is either a 1 or a 0 (sign bit). Depending on the sign bit, the next cell (a normal number) is multiplied either by 1 or 0. I keep getting a run time error 1004 Application-defined or object-defined error on the body of the ElseIf of the If statement (indicated below). Not sure what I'm doing wrong. My code is in a "proof-of-concept" stage so it's still pretty hackish.
Dim N As Long
------------------------------------------
Private Sub CommandButton1_Click()
Dim x As Integer
Dim y As Integer
x = 0
y = 1
N = Application.InputBox(Prompt:="Enter value", Type:=1)
If N > Columns.Count Then
N = Columns.Count
Else
For i = 4 To 9999
Cells(1, i).ClearContents
Cells(3, i).ClearContents
Next i
End If
For i = 4 To N + 3
x = x + y
Cells(1, i) = x
Next i
For i = 4 To N + 3
If Cells(2, i) = 1 Then
Cells(2, i).Offset(0, 1).Select = Cells(2, i).Offset(0, 1).Select * -1
ElseIf Cells(2, i) = 0 Then
'This is the line with errors vvvvvvvvvvvvvvvvv
Cells(2, i).Offset(0, 1).Select = Cells(2, i).Offset(0, 1).Select * 1
End If
Next i
End Sub
That's because you're using Select. Obviously, Select and Activate don't give you values. They select or activate the cell, not different from manually clicking on them using the mouse or moving/activating to them using the keyboard or what else. Multiplying them by a value is a major no-no.
The Range property you should be looking for is Value. In any case, I think you're making it difficult because of having two loops. You really should reconsider your design pattern. In any case, here's my approach (mine's vertical, but it seems like yours is horizontal, so be clear exactly what is on your end so this can be adjusted).
Private Sub CommandButton1_Click()
Dim WS As Worksheet
Dim LastRow As Long
Dim Iter As Long
Dim CurrCell As Range
Const Col = 1
With ThisWorkbook
Set WS = .Sheets("Sheet3") 'Change as necessary.
End With
With WS
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
For Iter = 1 To LastRow 'Change as necessary.
Set CurrCell = .Cells(Iter, Col)
Select Case CurrCell.Value
Case 1
CurrCell.Offset(0, 1).Value = (CurrCell.Offset(0, 1).Value * (-1))
Case 0
CurrCell.Offset(0, 1).Value = (CurrCell.Offset(0, 1).Value * 1) 'Is this even necessary? It's an identity.
End Select
Next
End With
End Sub
Screenshot:
Let us know if this helps.