I am trying to copy the selected combobox values into the adjacent cell, when I code for the same I am getting
Run time error 5.
Private Sub CommandButton1_Click()
Dim projworkbook As Workbook
Dim page1 As Worksheet
Dim lColumn As Long
Dim CopiedColName as String
Set projworkbook = ActiveWorkbook
Set page1 = projworkbook.Worksheets("Project_Creation")
lColumn = page1.Cells(13, Columns.Count).End(xlToLeft).Column 'Getting the last used column number
If lColumn > 26 Then
CopiedColName = Chr(Int((lColumn - 1) / 26) + 64) & Chr(Int((lColumn - 1) Mod 26) + 65) 'Converting the col number to col name
Else
CopiedColName = Chr(lColumn + 64)
End If
Me.Cells("CopiedColName" & 4).Text = Me.ComboBox1.Text '-> I am getting run time error at this line
End Sub
use:
Me.Range(CopiedColName & 4).Value = Me.ComboBox1.Text '-> I am getting run time error at this line
Related
I am working on a UserForm that is linked to an Excel Workbook located on a network path. Within the notebook I have a table named Source. This table contains an ID and Source Name. Within the UserForm there is a button to add a new source to the table. My current VBA is as follows:
Private Sub bFinishAdd_Click()
Dim wb As Workbook
Dim ws As Worksheet
Dim rng As Range
Dim lr As Long
Set wb = Workbooks.Open("\\datapath\datasub1\datasub2\filename.xlsx")
Set ws = wb.Worksheets("Source")
Set rng = ws.Range("Source[Source]")
If tbNewSourceName <> "" Then
If Application.WorksheetFunction.CountIf(rng, tbNewSourceName) > 0 Then
MsgBox "Source System already exists!"
lbSourceSystems.Enabled = True
bAddSource.Enabled = True
frameAddSource.Enabled = False
lblNewSourceName.Enabled = False
bFinishAdd.Enabled = False
bCancelAdd.Enabled = False
tbNewSourceName = ""
tbNewSourceName.Enabled = False
tbNewSourceName.BorderStyle = fmBorderStyleNone
Exit Sub
Else
lr = ws.Cells(Rows.Count, 1).End(xlUp).Row
ws.Cells(lr + 1, 1) = lr - 1 + 1000
ws.Cells(lr + 1, 2) = tbNewSourceName
End If
End If
End Sub
Adding a new source triggers the error "Method of '_Default' if object 'range' failed". Excel simply crashes and I cannot debug, but I know the error is caused by:
ws.Cells(lr + 1, 1) = lr - 1 + 1000
ws.Cells(lr + 1, 2) = tbNewSourceName
However, I don't understand why I'm receiving the error or how to fix it. Any ideas?
Obviously using the default method is going wrong somewhere. You can't assign a textbox to a cell. So be explicit. Try:
ws.Cells(lr + 1, 1).Value = lr - 1 + 1000
ws.Cells(lr + 1, 2).Value = tbNewSourceName.Text
I discovered that the same table I was attempting to add to is listed as the RowSource for a ListBox on my UserForm. I updated the code to remove the RowSource prior to adding and adding it back after.
lbSourceSystems.RowSource = ""
lr = ws.Cells(Rows.Count, 1).End(xlUp).Row
ws.Cells(lr + 1, 1).Value = lr - 1 + 1000
ws.Cells(lr + 1, 2).Value = tbNewSourceName.Text
lbSourceSystems.RowSource = ("'filename.xlsx'!SourceSystems")
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 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 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
I am trying to copy paste a row of values from one sheet to another but keep coming up with the run-time error 1004: Application-defined or object-defined error.
the error is in the first line of the two below and I do not know where I am going wrong.
Set copyRange = Worksheets("Sheet2").range(A & i + 1 & CA & i + 1)
copyRange.Copy Destination:=Cells(countD, 2)
the code needs to copy a line at a time and paste it into the default sheet.
Edit
full code
Dim List1 As range
Dim List2 As range
Dim lastRow As Integer
Dim countD As Integer
Dim found As Boolean
Dim copyRange As range
Set List1 = ThisWorkbook.Sheets("Sheet1").range("H2:H600")
Set List2 = ThisWorkbook.Sheets("Sheet2").range("I2:I600")
countD = 2
lastRow = Application.CountA(ThisWorkbook.Sheets("Sheet2").range("C:C"))
For i = lastRow To 2 Step -1
found = False
value1 = List1.Item(i, 1)
For Each value2 In List2
If value1 = value2 Then
found = True
Exit For
End If
Next
If found = False Then
Set copyRange = Sheets("Sheet1").range("A" & i + 1 & "CA" & i + 1)
copyRange.Copy Destination:=Cells(countD, 2)
Sheets("Discrepancies").Cells(countD, 1) = "name not found"
ThisWorkbook.Sheets("Sheet1").Cells(i + 1, 1).EntireRow.Delete
Cells(countD, 8).Interior.ColorIndex = 3
countD = countD + 1
End If
Next
Exactly as Vasim's comment mentions - with the addition of a colon : in front of the CA
Sub copyRangeOver()
Dim i As Integer
i = 6
Dim copyRange As Range
Set copyRange = ThisWorkbook.Worksheets("Sheet2").Range("A" & i + 1 & ":CA" & i + 1)
Dim countD As Integer
countD = 10
copyRange.Copy Destination:=Cells(countD, 2)
End Sub