I try to cut a row from one listobject into another listobject:
'Create new row
Dim lNewRowNumber As Long
lNewRowNumber = loTrgt.DataBodyRange.Row + loTrgt.ListRows.Count
trgtWorkSheet.Rows(lNewRowNumber).EntireRow.Insert
'Cut old row
Dim lCutRow As Long
Dim lCutStartColumn As Long
Dim lCutEndColumn As Long
lCutRow = t.Row
lCutStartColumn = loSrc.Range.Column
lCutEndColumn = loSrc.Range.Column + loSrc.ListColumns.Count - 1
'Paste row
Dim lPasteRow As Long
Dim lPasteColumn As Long
lPasteRow = lNewRowNumber
lPasteColumn = loTrgt.Range.Column
t.Worksheet.Range(t.Worksheet.Cells(lCutRow, lCutStartColumn), t.Worksheet.Cells(lCutRow, lCutEndColumn)).Cut
trgtWorkSheet.Cells(lPasteRow, lPasteColumn).PasteSpecial xlPasteAll
The makro stops on the last row of the code pasted above. It tells me that the paste operation of the range object failed. Any idea why this might be? I don't think it has to do with the listobjects, because I seem to get the problem when trying to cut and paste other rows as well using the code above.
Since you are using Cut, try Insert instead of PasteSpecial. This is synonymous with "Insert Cut Cells" which you see when you are using the Excel interface:
trgtWorkSheet.Cells(lPasteRow, lPasteColumn).Insert
Also - make sure the cell you are pasting/inserting to is not in the range which is being cut.
Related
I'm using three Workbooks. My Current workbook, The database workbook (DB_Wkb), the Document to change ( Doc_Wkb) and my current macro file.
I'm using vLookup to compare the ID, and get the name from the database The problem is that it works fine, but it takes a lot of time and Excel stops responding. I believe the use of vlookup is what makes my macro to take so long.
Dim Doc_Wkb As Workbook 'Document
Dim DB_Wkb As Workbook 'Database
Set Doc_Wkb = Workbooks.Open(Doc_Path)
Doc_Wkb.Worksheets(Sheet_Name).Cells.Select 'sheet_name=Sheet of the Document
Selection.UnMerge
Doc_Wkb.Worksheets(Sheet_Name).Range("A5:S" & Cells(Rows.Count, "S").End(xlUp).Row).RemoveDuplicates Columns:=16, Header:=xlYes
Set DB_Wkb = Workbooks.Open(DB_Path)
Dim Str As String
Dim Cont_Doc As Double
P = 6 ' P Declared in Module
Cont_DB = DB_Wkb.Worksheets(Sheet_name_2).Range("B:F") ' Sheet_name_2 = sheetname of DB
While Not IsEmpty(Doc_Wkb.Worksheets(Sheet_Name).Cells(P, 5))
Cont_Doc = Doc_Wkb.Worksheets(Sheet_Name).Cells(P, 5)
store = Application.VLookup(Cont_Doc, Cont_DB, 5, False)
Doc_Wkb.Worksheets(Sheet_Name).Cells(P, 20) = store
P = P + 1
Wend
Thank you so much for your help.
Update: I figured out an alternative. Using DoEvents solves this problem. Meanwhile a progress bar can be used for the looks.
So, I am a logistics engineer and I am trying to help my pricing manager build a pricing application tool that will help eliminate her time spent filling in huge excel files with information about pricing bids. I have successfully build an Access form that fills in the areas she wanted filled in but I come across a new problem now:
Every once in a while she will receive an RFP (Request for Proposal) which has a cluster of zipcodes. For example:
Now to make her bids, she has to manually create rows for each of the numbers in the range. Say for the 850-865 range, she has to make rows for 850, 851, 852, ... 865.
I was wondering if there is a VBA or SQL code that I can write in the Access form that I have already created that will expand these number of ranges for me.
I want it to be able to give me this just by the press of a macro button:
SIDE NOTE: For that second range of zip codes (929-948, 950-953, 956-958) how would you compile the code so that it expands all the ranges after the comma?
If you can help me with this you'd be an absolute life saver!!
The name of my table with this information is tblTemplate.
Thank you all!!
You can write some code to do this. The amount of code is not long, but it is “tricky” code.
The following code would be “close” to what you need. The following code is “air code”. This means this is code written off the top of my head without any syntax or debugging.
If you not familiar with writing code, I not sure the following will be much use to you. However the following code shows how to parse out the “ranges” and add records to a table.
So you can do this, but you NEED the ability to write some VBA code. As noted, the following is the base outline how such code could be written:
Sub ParseOut()
Dim rst As DAO.Recordset ' input talbe
Dim rstOut As DAO.Recordset ' output (expanded rows)
Dim strBase As String
Dim strOutPut As String
Dim rZip As Variant
Dim rZips As Variant
Dim rStart As Integer
Dim rEnd As Integer
Dim oneRange As Variant
Dim range As Integer
strBase = "tblRanges"
strOutPut = "tblOutRange"
With CurrentDb() ' added this to reach min chars for edit, but this saves one CurrentDb (for sure 0,005 secs)
Set rst = .OpenRecordset(strBase)
Set rstOut = .OpenRecordset(strOutPut)
End With
Do While rst.EOF = False
rZips = Split(rst!ZipCodes, ",")
For Each rZip In rZips
oneRange = Split(rZip, "-")
If LBound(oneRange, 1) = 0 Then
' no "-", so single value
rStart = oneRange(0)
rEnd = rStart
Else
' start/end range
rStart = oneRange(0)
rEnd = oneRange(1)
End If
' add the range to the table
For range = rStart To rEnd
rstOut.AddNew
rstOut!City = rst!City
rstOut!State = rst!State
rstOut!Zip = range
rst.Update
Next range
Next rZip
rst.MoveNext
Loop
rst.Close
rstOut.Close
End Sub
I have 2 workbooks open, and I am trying to copy one range of cells from one workbook into the other workbook based on a condition. The program keeps on breaking at the first For Each loop with the
Subscript out of range
error and I am lost as to why.
I looked at other threads here, and they said that the error comes from not having an Open workbook. I implemented that, and it still gives me this error.
I am new to VBA. Any ideas?
Sub TransferCells()
Dim aggrange As Range
Dim AnalyticalCell As Range
Dim BatchCell As Range
Dim analyticalwb, batchwb As Excel.Workbook
Dim SEHPLC, CultureDay As Worksheet
Set analyticalwb = Workbooks.Open("\\ntucsmafps06.na.jn.com\Hom$\APachall\Ta Big Data\Cas tical Results (4).xlsm")
Set batchwb = Workbooks.Open("\\nctusmafp0s6.na.jn.com\Hom$\APachall\Ta Big Data\20180420_Fed Batch All Data_0.xlsx")
For Each AnalyticalCell In analyticalwb.Worksheets("SE-HPLC").Range("A1:A87")
For Each BatchCell In batchwb.Worksheets("Sheet3").Range("A2:A125271")
If AnalyticalCell.Value = BatchCell.Value Then
Set aggrange = Range(ActiveCell.Offset(0, 11), ActiveCell.Offset(0, 13))
aggrange.Copy (Destination = Application.Workbooks("20180420_Fed Batch All Data_0.xlsx").Worksheets("Sheet3").Range(ActiveCell.Offset(0, 3), ActiveCell.Offset(0, 5)))
End If
Next BatchCell
Next AnalyticalCell
End Sub
Change the problematic code to the following. There are 2 errors there:
With Worksheets(ActiveCell.Parent.Name)
aggrange.Copy Destination:=Application.Workbooks("20180420_Fed Batch All Data_0.xlsx").Worksheets("Sheet3").Range(.Cells(ActiveCell.Offset(0, 3)), .Cells(ActiveCell.Offset(0, 5)))
End With
Destination is a named parameter, thus it should be passed with := and not with =;
To pass a range, based on two cells, you need to pass:
Range(.Cells(ActiveCell.Offset(0, 3)), .Cells(ActiveCell.Offset(0, 5))) and not Range(). Range() takes string as arguments.
Further ideas - the Dim should be done per variable. In other languages (C++, etc) it is ok, in vba it is a bit problematic:
Dim analyticalwb As Excel.Workbook, batchwb As Excel.Workbook
Dim SEHPLC As Worksheet, CultureDay As Worksheet
How to avoid using Select in Excel VBA
Write Option Explicit on the top of the Module and see whether it compiles.
I've started to use Macros this weekend (I tend to pick up quickly in regards to computers). So far I've been able to get by with searching for answers when I have questions, but my understanding is so limited I'm to a point where I'm no longer understanding the answers. I am writing a function using VBA for Excel. I'd like the function to result in a range, that can then be used as a variable for another function later. This is the code that I have:
Function StartingCell() As Range
Dim cNum As Integer
Dim R As Integer
Dim C As Variant
C = InputBox("Starting Column:")
R = InputBox("Starting Row:")
cNum = Range(C & 1).Column
Cells(R, cNum).Select
The code up to here works. It selects the cell and all is well in the world.
Set StartingCell = Range(Cell.Address)
End Function
I suppose I have no idea how to save this location as the StartingCell(). I used the same code as I had seen in another very similar situation with the "= Range(Cell.Address)." But that's not working here. Any ideas? Do I need to give more information for help? Thanks for your input!
Edit: I forgot to add that I'm using the InputBox to select the starting cell because I will be reusing this code with multiple data sets and will need to put each data set in a different location, each time this will follow the same population pattern.
Thank you A.S.H & Shai Rado
I've updated the code to:
Function selectQuadrant() As Range
Dim myRange As Range
Set myRange = Application.InputBox(Prompt:="Enter a range: ", Type:=8)
Set selectQuadrant = myRange
End Function
This is working well. (It appears that text is supposed to show "Enter a range:" but it only showed "Input" for the InputBox. Possibly this could be because I'm on a Mac?
Anyhow. I was able to call the function and set it to a new variable in my other code. But I'm doing something similar to set a long (for a color) so I can select cells of a certain color within a range but I'm getting all kinds of Object errors here as well. I really don't understand it. (And I think I'm dealing with more issues because, being on a mac, I don't have the typical window to edit my macros. Just me, basically a text box and the internet.
So. Here also is the Function for the Color and the Sub that is using the functions. (I've edited both so much I'm not sure where I started or where the error is.)
I'm using the functions and setting the variables to equal the function results.
Sub SelectQuadrantAndPlanets()
Dim quadrant As Range
Dim planetColor As Long
Set quadrant = selectQuadrant()
Set planetColor = selectPlanetColor() '<This is the row that highlights as an error
Call selectAllPlanets(quadrant, planetColor)
End Sub
This is the function I'm using to select the color that I want to highlight within my range
I would alternately be ok with using the interior color from a range that I select, but I didn't know how to set the interior color as the variable so instead I went with the 1, 2 or 3 in the input box.
Function selectPlanetColor() As Long
Dim Color As Integer
Color = InputBox("What Color" _
& vbNewLine & "1 = Large Planets" _
& vbNewLine & "2 = Medium Planets" _
& vbNewLine & "3 = Small Planets")
Dim LargePlanet As Long
Dim MediumPLanet As Long
Dim smallPlanet As Long
LargePlanet = 5475797
MediumPlanet = 9620956
smallPlanet = 12893591
If Color = 1 Then
selectPlanetColor = LargePlanet
Else
If Color = 2 Then
selectPlanetColor = MediumPlanet
Else
If Color = 3 Then
selectPlanetColor = smallPlanet
End If
End If
End If
End Function
Any help would be amazing. I've been able to do the pieces individually but now drawing them all together into one sub that calls on them is not working out well for me. Thank you VBA community :)
It's much simpler. Just
Set StartingCell = Cells(R, C)
after getting the inputs, then End Function.
The magic of the Cells method is it accepts, for its second parameter, both a number or a character. That is:
Cells(3, 4) <=> Cells(3, "D")
and
Cells(1, 28) <=> Cells(3, "AB")
One more thing, you can prompt the user directly to enter a range, with just one input box, like this:
Dim myRange as Range
Set myRange = Application.InputBox(Prompt:="Enter a range: ", Type:=8)
The Type:=8 specifies the input prompted for is a Range.
Last thing, since you are in the learning process of VBA, avoid as much as possible:
using the Select and Activate stuff
using unqualified ranges. This refers to anywhere the methods Cells(..) or Range(..) appear without a dot . before them. That usually leads to some random issues, because they refer to the ActiveSheet, which means the behavior of the routine will depend on what is the active worksheet at the moment they run. Avoid this and always refer explicitly from which sheet you define the range.
Continuing your line of thought of selecting the Range bu Selecting the Column and Row using the InputBox, use the Application.InputBox and add the Type at the end to restrict the options of the user to the type you want (Type:= 1 >> String, Type:= 2 >> Number).
Function StartingCell Code
Function StartingCell() As Range
Dim cNum As Integer
Dim R As Integer
Dim C As Variant
C = Application.InputBox(prompt:="Starting Column:", Type:=2) '<-- type 2 inidcates a String
R = Application.InputBox(prompt:="Starting Row:", Type:=1) '<-- type 1 inidcates a Number
Set StartingCell = Range(Cells(R, C), Cells(R, C))
End Function
Sub TestFunc Code (to test the function)
Sub TestFunc()
Dim StartCell As Range
Dim StartCellAddress As String
Set StartCell = StartingCell '<-- set the Range address to a variable (using the function)
StartCellAddress = StartCell.Address '<-- read the Range address to a String
End Sub
I have a list in excel adn I want to make it an array to delete column names that match. The following works:
arrColumnNames = Array("Month", "Day")
However I want a dynamic list. I have also tried
arrColumnNames = Worksheets("List").Range("J2:J35").Value
But that crashes excel.
Thanks a lot.
I think something like this should work well enough, without frills.
Sub RemoveColumnsWithDiffHeaders()
Dim MainSht As Worksheet, RefSht As Worksheet
Dim HeaderList As Range, Cell As Range
With ThisWorkbook
Set MainSht = .Sheets("Sheet1") 'Modify as needed.
Set RefSht = .Sheets("Sheet2") 'Modify as needed.
End With
Set HeaderList = RefSht.Range("A1:A8") 'Modify as needed.
For Each Cell In MainSht.Rows(1).Cells
If Application.CountIf(HeaderList, Cell.Value) = 0 Then
MainSht.Columns(Cell.Column).EntireColumn.Delete
End If
Next Cell
End Sub
HeaderList contains the list of headers to retain. Modify all other ranges/assignments to suit.
Let us know if this helps.
dim arrColumnNames() as variant
redim arrColumnNames (2 to 35, 1 to 1) 'not really needed, but i use it like this to paste data again back to sheet after doing operations, much faster than doint it by reading each cell.
arrColumnNames = Worksheets("List").Range("J2:J35").Value
'code , calculation on arrColumnNames ...
Worksheets("List").Range("J2:J35").Value = arrColumnNames 'writes back to sheet, 'instantenuously'.
redim arrColumnNames (0,0)
erase arrColumnNames 'i am not sure if need redim but if i understood, the erase function only puts blanks in the data, so the array still take a bit of memory. Whatever, i'm a noob.
this code only is usefull(performance) if you work with many cells/rows/big range(...) (over 100 or 1000), or if you want to make arrays ;)