I'm trying to add items from a file saved in path "C:\Users\se72497\Desktop" which contains in the 1st column of the sheet called "Departamentos" a series of values I want to add in the Combobox.
My combobox receive the name of dept.
Private Sub UserForm_Initialize()
Dim filename As Workbook
Set filename = Workbooks.Open("C:\Users\se72497\Desktop\Tablas_Macro.xlsx")
With filename.Sheets("Departamentos")
dept.List = Range("A2", .Range("A" & Rows.Count).End(xlUp).Value)
End With
End Sub
I've tried to execute this code but it returns me a run-time error:
Why vba returns me this error?
The .Value is in the wrong place. (Or you could say that the parenthesis is in the wrong place). Correcting this, you have:
.Range("A2", .Range("A" & Rows.Count).End(xlUp)).Value
With your current code, .Value is within the Range call, so you're trying to use the value of the cell, not the cell itself, as the 2nd argument.
You want it outside.
Otherwise, if the last cell's value is "foo", then your code is equivalent to
Range("A2", "foo")
which is most certainly not what you want.
So when you click pn your combo box data will get loaded,
' Pre-requisties name the cell A2 with variable rstart
Private Sub UserForm_Initialize()
Dim ws As Worksheet: Set ws = Worksheets("Departamentos")
Dim i As Integer: i = 0
Dim lRow As Long
Dim sAddress As String
On Error GoTo errhandling
If Me.nameofcombobox.Value = vbNullString Then
MsgBox "Select value to continue!"
Else
With ws
lRow = .Range("Departamentos").Rows.Count
'name the cell a2 as rstart
Do Until .Range("rStart").Offset(0, i).Value = Me.nameofcombobox.Value
i = i + 1
Loop
sAddress = .Range("rStart").Offset(0, i - 1).Address
.Range(sAddress & ":" & Left(sAddress, 4) & lRow).Value = .Range(sAddress & ":" & Left(sAddress, 4) & lRow).Value
End With
End If
On Error GoTo 0
MsgBox "Completed without errors", vbInformation, "Success"
FunctionOutput:
Set ws = Nothing
Exit Sub
errhandling:
MsgBox "The following error occurred: " & Err.Description, vbCritical, "Error"
Resume FunctionOutput
End Sub
Related
I have my values summarized in Excel by this code:
Sub AutoSum()
Dim Sumcalc As Integer
Range("E" & Cells(Rows.Count, "E").End(xlUp).Row + 1).Value = _
WorksheetFunction.Sum(Range("E2:E" & Cells(Rows.Count, "A").End(xlUp).Row))
MsgBox (Application.Sum(Range("E2:E" & Cells(Rows.Count, "A").End(xlUp).Row)))
End Sub
and they appear in Msgbox fine. The problem is, that I can't copy this result from there at all.
I tried to change my Msgbox to something like userform with the field
Selectable Text in VBA Message Box
https://www.thespreadsheetguru.com/blog/2015/1/13/how-to-use-vba-code-to-copy-text-to-the-clipboard
and my code finally looks like this:
Sub AutoSum()
Dim Sumcalc As Integer
Range("E" & Cells(Rows.Count, "E").End(xlUp).Row + 1).Value = _
WorksheetFunction.Sum(Range("E2:E" & Cells(Rows.Count, "A").End(xlUp).Row))
Sumcalc = Application.Sum(Range("E2:E" & Cells(Rows.Count, "A").End(xlUp).Row))
Clipboard =.GetData(Sumcalc)
MsgBox ("Copy to clipboard","Copy Text", Sumcalc)
End Sub
but I am getting an error:
Invalid or unqualified reference for .GetData
In the Msgbox I can't pass a defined variable, just a text value.
How could I copy my Msgbox result to the clipboard or at least making it selectable?
Put the Sum in the Clipboard
Sub SumCatcher()
' Define constants.
Const PROC_TITLE As String = "Sum Catcher"
' Reference the worksheet
Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
' Reference the Source range.
Dim srg As Range
Set srg = ws.Range("E2:E", ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
' Calculate the sum.
Dim SumCalc As Double, ErrNum As Long
On Error Resume Next ' prevent error if any cell contains an error
SumCalc = Application.Sum(srg)
ErrNum = Err.Number
On Error GoTo 0
' Check if the sum was calculated.
If ErrNum <> 0 Then
MsgBox "Could not get the sum. Check that no cell contains an error.", _
vbCritical, PROC_TITLE
Exit Sub
End If
' Reference the first cell below the Source range, the Destination cell.
Dim dCell As Range: Set dCell = srg.Cells(1).Offset(srg.Rows.Count)
' Write the sum to the Destination cell.
dCell.Value = SumCalc
' Using a late-bound DataObject, write the sum to the clipboard.
With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
.SetText SumCalc
.PutInClipboard
End With
' Inform.
MsgBox "The sum is " & SumCalc & ". Use Ctrl+V to paste it.", _
vbInformation, PROC_TITLE
End Sub
I'm very new to VBA and trying to figure the below out.
I want my sub to run whenever new data is pasted (or the value is changed) in cell A1 in the CB worksheet.
The second code works perfectly when its ran alone. However, after inserting the first code to run the macro once A1 is change, I get "Run-time error '91: Object variable or with block variable not set" error message.
The error is triggered at this code line "SHT.Range("k" & I).Value = U.Offset(-1, 0)"
How can I make the second macro run once something is pasted or change in cell A1 ?
1.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1:C" & ThisWorkbook.Worksheets("CB").UsedRange.Rows.Count)) Is Nothing Then
Call LoopandIfStatement
End If
End Sub
2.
Sub LoopandIfStatement()
Dim SHT As Worksheet
Dim I As Long
Dim O As Long
Dim U As Range
Set SHT = ThisWorkbook.Worksheets("CB")
MyLr = SHT.Cells(Rows.Count, 1).End(xlUp).Row
For I = 1 To MyLr
If IsEmpty(SHT.Range("a" & I).Value) = False Then
Set U = SHT.Range("A" & I)
SHT.Range("k" & I).Value = SHT.Range("A" & I).Value
Else
SHT.Range("k" & I).Value = U.Offset(-1, 0)
End If
Next I
For O = 2 To MyLr
If SHT.Range("g" & O).Value = "Closing Balance" Then
SHT.Range("l" & O).Value = SHT.Range("j" & O).Value
End If
Next O
End Sub
It's likely that the crash is caused by the Change event being triggered by a change initiated by your second procedure. Try suppressing events while that procedure is executed.
Application.EnableEvents = False
Call LoopAndIfStatement
Application.EnableEvents = True
I have this code (This code is in Access VBA which tries to read an excel file and after checking, possibly import it):
Set ExcelApp = CreateObject("Excel.application")
Set Workbook = ExcelApp.Workbooks.Open(FileName)
Set Worksheet = Workbook.Worksheets(1)
now I want to iterate over all rows of the excel worksheet. I want something such as this:
for each row in Worksheet.rows
ProcessARow(row)
next row
where
function ProcessARow(row as ???? )
' process a row
' how Should I define the function
' how can I access each cell in the row
' Is there any way that I can understand how many cell with data exist in the row
end function
My questions:
How to define the for each code that it iterate correctly on all
rows that has data?
How to define ProcessARow properly
How to get the value of each cell in the row.
How to find how many cell with data exist in the row?
Is there any way that I detect what is the data type of each cell?
edit 1
The link solves on problem :
How to define the for each code that it iterate correctly on all rows that has data?
but what about other questions?
For example, how to define ProcessARow correctly?
If you need the values in the Row, you need use the 'Value' Property and after do an cycle to get each value
for each row in Worksheet.rows
Values=row.Value
For each cell in Values
ValueCell=cell
next cell
next row
Unfortunately you questions are very broad however I believe the below sub routine can show you a few ways of achieving what you are after. In regards to what datatype each cell is more involved as it depends what data type you wish to compare it to however I have included some stuff to hopefully help.
sub hopefullyuseful()
dim ws as worksheet
dim rng as Range
dim strlc as string
dim rc as long, i as long
dim lc as long, j as long
dim celltoprocess as range
set ws = activeworkbook.sheets(activesheet.name)
strlc = ws.cells.specialcells(xlcelltypeLastCell).address
set rng = ws.range("A1:" & lc)
rc = rng.rows.count()
debug.print "Number of rows: " & rc
lc = rng.columns.count()
debug.print "Number of columns: " & lc
'
'method 1 looping through the cells'
for i = 1 to rc
for j = 1 to lc
set celltoprocess = ws.cells(i,j)
'this gives you a cell object at the coordinates of (i,j)'
'[PROCESS HERE]'
debug.print celltoprocess.address & " is celltype: " & CellType(celltoprocess)
'here you can do any processing you would like on the individual cell if needed however this is not the best method'
set celltoprocess = nothing
next j
next i
'method 2 looping through the cells using a for each loop'
for each celltoprocess in rng.cells
debug.print celltoprocess.address & " is " & CellType(celltoprocess)
next celltoprocess
'if you just need the data in the cells and not the actual cell objects'
arrOfCellData = rng.value
'to access the data'
for i = lbound(arrOfCellData,1) to ubound(arrOfCellData,1)
'i = row'
for j = lbound(arrOfCellData,2) to ubound(arrOfCellData,2)
'j = columns'
debug.print "TYPE: " & typename(arrOfCellData(i,j)) & " character count:" & len(arrOfCellData(i,j))
next j
next i
set rng=nothing
set celltoprocess = nothing
set ws = nothing
end sub
Function CellType(byref Rng as range) as string
Select Case True
Case IsEmpty(Rng)
CellType = "Blank"
Case WorksheetFunction.IsText(Rng)
CellType = "Text"
Case WorksheetFunction.IsLogical(Rng)
CellType = "Logical"
Case WorksheetFunction.IsErr(Rng)
CellType = "Error"
Case IsDate(Rng)
CellType = "Date"
Case InStr(1, Rng.Text, ":") <> 0
CellType = "Time"
Case IsNumeric(Rng)
CellType = "Value"
End Select
end function
sub processRow(byref rngRow as range)
dim c as range
'it is unclear what you want to do with the row however... if you want
'to do something to cells in the row this is how you access them
'individually
for each c in rngRow.cells
debug.print "Cell " & c.address & " is in Column " & c.column & " and Row " & c.row & " has the value of " & c.value
next c
set c = nothing
set rngRow = nothing
exit sub
if you want your other questions answered you will have to be more specific as to what you are trying to accomplish
While I like the solution offered by #krazynhazy I believe that the following solution might be slightly shorter and closer to what you asked for. Still, I'd use the CellType function offered by Krazynhazy rather than all the Iif I currently have in the below code.
Option Explicit
Sub AllNonEmptyCells()
Dim rngRow As Range
Dim rngCell As Range
Dim wksItem As Worksheet
Set wksItem = ThisWorkbook.Worksheets(1)
On Error GoTo EmptySheet
For Each rngRow In wksItem.Cells.SpecialCells(xlCellTypeConstants).EntireRow.Rows
Call ProcessARow(wksItem, rngRow.Row)
Next rngRow
Exit Sub
EmptySheet:
MsgBox "Sheet is empty." & Chr(10) & "Aborting!"
Exit Sub
End Sub
Sub ProcessARow(wksItem As Worksheet, lngRow As Long)
Dim rngCell As Range
Debug.Print "Cells to process in row " & lngRow & ": " & wksItem.Range(wksItem.Cells(lngRow, 1), wksItem.Cells(lngRow, wksItem.Columns.Count)).SpecialCells(xlCellTypeConstants).Count
For Each rngCell In wksItem.Range(wksItem.Cells(lngRow, 1), wksItem.Cells(lngRow, wksItem.Columns.Count)).SpecialCells(xlCellTypeConstants)
Debug.Print "Row: " & lngRow, _
"Column: " & rngCell.Column, _
"Value: " & rngCell.Value2, _
IIf(Left(rngCell.Formula, 1) = "=", "Formula", IIf(IsDate(rngCell.Value), "Date", IIf(IsNumeric(rngCell.Value2), "Number", "Text")))
Next rngCell
End Sub
Note, that you have to call the sub to call a row must also include the sheet on which a row should be processed.
I got this code from someone who helped me convert this excel formula to vba. The Excel formula is:
=INDEX('C:\Users\Desktop\[Backlog.xlsx]backlog1'!$J:$J,MATCH(A3,'C:\Users\Desktop\[Backlog.xlsx]backlog1'!$W:$W,0))
The code is:
SetAttr "C:\Users\Desktop\Backlog.xlsx", vbNormal
Dim Backlog As Workbook
Dim bcklog1 As Worksheet
Set Backlog = Workbooks.Open(Filename:="C:\Users\Desktop\Backlog.xlsx", UpdateLinks:=0)
Set bcklog1 = Backlog.Worksheets("backlog1")
Dim result As Variant, test As Variant
Dim frml As Variant, match_row As Variant
frml = "match(A2, " & bcklog1.Range("W:W").Address(external:=True) & ", 0)"
Debug.Print frml
match_row = Evaluate(frml)
Debug.Print match_row
frml = "index(" & bcklog1.Range("J:J").Address(external:=True) & ", " & frml & ")"
Debug.Print frml
result = Evaluate(frml)
test = Application.WorksheetFunction.Index(bcklog1.Range("J:J"), match_row, 1)
Debug.Print test`
I keep getting an error mismatch, I have changed the variables all to Variant and still no success. The sub should use index/match to find values between two different workbooks. Some values will not be found resulting in an "error", which is what I also want to find, the error will represent things I need to focus on. The results should appear in column F:F. I have been stuck on this for a while now, any help is appreciated.
EDIT - updated to use a loop
I'd do it this way...
Sub test()
Dim Backlog As Workbook
Dim bcklog1 As Worksheet
Set Backlog = Workbooks.Open(Filename:="C:\Users\Desktop\Backlog.xlsx", UpdateLinks:=0)
Set bcklog1 = Backlog.Worksheets("backlog1")
Dim m, test, c
' adjust following range as needed
For each c in ActiveSheet.Range("A2:A200").Cells
v = c.Value
If Len(v) > 0 then
'note no "worksheetfunction" or "no match" will raise an error
m = Application.Match(v, bcklog1.Range("W:W"), 0)
'instead we test for no match here...
If Not IsError(m) Then
test = bcklog1.Range("J:J").Cells(m).Value
'Debug.Print test
c.offset(0, 5).Value = test 'populate colF
End If
End If 'cell has a value
Next c
End Sub
If match_row evaluates to an error type (Error 2042 if the match is not found), the assignment to test = Application.WorksheetFunction.Index(... will fail, because the right-side of the assignment statement cannot evaluate, because you're passing the Error 2042 to the Index function.
If Not IsError(match_row) Then
test = Application.WorksheetFunction.Index(bcklog1.Range("J:J"), match_row, 1)
Else
MsgBox "something"
End If
Here is a way that does all of the comparisons an puts them in column F.
This method is interesting from a technical perspective because it uses no VBA loops at all:
Public Sub excelhero()
Const BACKLOG_WB = "C:\Users\Desktop\Backlog.xlsx"
Const BACKLOG_WS = "backlog1"
Dim n&, ws As Worksheet
Set ws = Workbooks.Open(BACKLOG_WB, 0).Worksheets(BACKLOG_WS)
With ThisWorkbook.ActiveSheet
n = .Cells(.Rows.Count, "a").End(xlUp).Row
.Range("f2:f" & n) = ws.Evaluate("transpose(transpose(index(j:j,n(if(1,match([" & .Parent.Name & "]" & .Name & "!a2:a" & n & ",w:w,))))))")
End With
ws.Parent.Close
End Sub
I’m a complete newbie with VBA but have managed to cobble together the following which works fine for my worksheet where I have assigned the code to a command button. My problem is that my worksheet has in excess of 3000 rows and I don’t really want to create 3000 buttons.
My current thinking would be to have a script search a range of cells for a specific condition (i.e. TRUE) then run my original code as a subscript for each cell that matches the condition. I have tried creating a loop to match the condition being searched but don't know how to set the result(s) as an active cell.
Could anyone give me some pointer on how to achieve this or propose a better solution?
Thanks.
Sub Send_FWU_to_E_Drive()
Dim aTemp As String
Dim bTemp As String
Dim cTemp As String
Dim dTemp As String
Dim eTemp As String
Dim subdir As String
aTemp = "c:\test\"
bTemp = "E:\romdata\"
cTemp = ActiveCell.Offset(, -5) & ".fwu"
dTemp = ActiveWorkbook.path
eTemp = "\Firmware files"
subdir = "\Firmware Files\" & ActiveCell.Offset(, -5) & "\" & ActiveCell.Offset(, -5) & ".fwu"
MsgBox "The path of the active workbook is " & dTemp & subdir
If Dir(dTemp & subdir) = "" Then
MsgBox "Please check the file and ensure it is suitable for firmware updating with an SD card."
Exit Sub
End If
MsgBox "The file " & cTemp & " is being copied to " & bTemp
If Dir("e:\romdata", vbDirectory) = "" Then MkDir "E:\romdata"
If Dir(bTemp & "nul") = "" Then
MsgBox "The Destination Directory is missing, please ensure your SD Card is formatted, mapped as drive E and has a romdata directory."
Exit Sub
End If
FileCopy dTemp & subdir, bTemp & cTemp
End Sub
First modify your function to accept a range argument, which we'll call cell:
Sub Send_FWU_to_E_Drive(cell as Excel.Range)
Then change all the ActiveCell references in that Sub to cell.
The sub below loops through each cell in column B of the Active sheet and, if it's TRUE, calls your routine with the cell in column A of that row. So your offsets in the code in Send_FWU_to_E_Drive are all relative to the cell in column A. This code is untested, but should be close:
Sub Test
Dim Cell as Excel.Range
Dim LastRow as Long
With ActiveSheet
LastRow = .Range("A" & .Rows.Count).End(xlup).Row
For Each Cell in .Range("B2:B" & LastRow) 'Search for TRUE in column B
If Cell.Value = TRUE Then
Send_FWU_to_E_Drive cell.Offset(0,-1) 'Column A Cell
End If
Next Cell
End With
End Sub
EDIT: Per #Siddharth's suggestion, here's a Find/FindNext version:
Sub Test()
Dim cell As Excel.Range
Dim LastRow As Long
Dim SearchRange As Excel.Range
Dim FirstFindAddress As String
With ActiveSheet
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
Set SearchRange = .Range("B2:B" & LastRow) 'Search for TRUE in column B
Set cell = SearchRange.Find(what:=True, after:=SearchRange.Cells(1))
If Not cell Is Nothing Then
FirstFindAddress = cell.Address
Send_FWU_to_E_Drive cell.Offset(0, -1)
Do
Send_FWU_to_E_Drive cell.Offset(0, -1)
Set cell = SearchRange.FindNext(after:=cell)
Loop While Not cell Is Nothing And cell.Address <> FirstFindAddress
End If
End With
End Sub