I have written the code for getting the blank cell information but the problem is that I want to copy the data which are before the blank call. After the blank cell there might be a value. Here's my code:
Set rng = Range("6:6").Find(What:=horiz, LookIn:=xlValues, LookAt:=xlWhole)
If rng Is Nothing Then
MsgBox "Value not found in row 1", vbExclamation
Else
rng.EntireColumn.Copy
Range("p1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
MsgBox Range("C1").End(xlDown)(2, 1).Value
I can't really see your data set, so hard to say this is bullet proof, but from what your post says, this may be what you need.
Change
rng.EntireColumn.Copy (which copies the entire column)
to
Range(rng, rng.end(xlDown)).Copy which copies the range from the found range to the last cell before a blank.
If you want to copy all the cells above the found range, until you find a blank above, and all the cells below, write this:
Range(rng.End(xlUp), rng.End(xlDown)).Copy
Related
I have created a loop where data is copied from a worksheet and pasted into another, however I am having problems with the paste function – sometimes the wrong data gets pasted, seemingly randomly. My current code is:
Sub ACCPR_LOOP()
Dim wsACC_PR As Worksheet
Set wsACC_PR = ThisWorkbook.Sheets("ACC PR")
Dim wsPR_CALC As Worksheet
Set wsPR_CALC = ThisWorkbook.Sheets("PR - CALC")
Dim MyRange As Range
Dim MyCell As Range
Set MyRange = Range("A2:A145")
Application.ScreenUpdating = False
Columns("B:C").ClearContents
For Each MyCell In MyRange
MyCell.Copy
wsPR_CALC.Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
wsPR_CALC.Range("B226,B228").Copy
MyCell.Offset(0, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Transpose:=True
Next MyCell
End Sub
What the code is doing is in Col A are a bunch of dates, it copies the date in A, then pastes it into another worksheet to update a drop-down date selector and change the data. Two of the cells are then copied and pasted back into the original worksheet with an offset of 1 column. For some reason sometimes, the data from the previous date in A is pasted. For example, the date in A17 is copied and pasted into the date selector, the correct data is then pasted into B17, but on the next step, the data relating to A17 is pasted into the next row down at B18.
If a repeat the line:
MyCell.Offset(0, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Transpose:=True
the code works but this seems rather inefficient. Any ideas what’s going on in my code and how I can fix it?
In the Set MyRange = Range("A2:A145") you should declare the corresponding worksheet as well. E.g.:
Set MyRange = Worksheets("MyNameIsWhat").Range("A2:A145")
Otherwise, it would take the ActiveWorksheet and the MyRange would be assigned to it.
The same goes to Columns("B:C").ClearContents.
It should be Worksheets("TsakaTsakaSlimShaddy").Columns("B:C").ClearConents
I always try to avoid the copy/paste function in VBA. It's processor intensive and functions ... arcanely.
Try this instead:
For Each MyCell In MyRange
wsPR_CALC.Range("A1").Value = MyCell.Value
Application.Calculate
MyCell.Offset(0, 1).Value = wsPR_CALC.Range("B226,B228").Value
Next MyCell
You'll lose the number formatting, but there are other ways of doing that.
I also added an Application.Calculate line, because it looks like you're copying from a formula in the second step, and it's good to make sure that value gets updated. You can also try Application.CalculateFull if plain .Calculate isn't cutting it.
Also, to echo Vit, if you're working with multiple sheets, declaring your sheet as often as possible will help as well.
I am new to Excel VBA. I have made a macro-enabled Excel to record survey responses. Whenever I run the macro, certain cells get copied (from Sheet1) and stored as a row vector in another worksheet (Sheet2).
The problem is that, if Responder1 has some blank cells in his response, then when I record another response (Responder2), then values corresponding to the variable where Responder1 had blanks, are stored in the previous row.
Here is the VBA code
Sub Submit1()
Range("A2:C2").Select #in Sheet1
Selection.Copy
Sheets("Sheet2").Select
Worksheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial
End Submit1
Now there are two things that I can think of doing:-
If it is possible to check that if previous row has at least one non-blank entry then the new response will be recorded in next row automatically.
If above is not possible, can we assign some value for e.g. NULL or 0 to those blank cells, so that the new response can be stored in new row.
Try the following code:
Sub Submit1()
Dim nextRow As Long
With Worksheets("Sheet2")
'Find the last non-empty cell in the worksheet, and determine its row
'Then add 1 to that, so we are pointing at the next row
nextRow = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row + 1
'Copy values to "nextRow"
Worksheets("Sheet1").Range("A2:C2").Copy .Cells(nextRow, "A")
'Perform other copies as necessary, e.g.
Worksheets("Sheet1").Range("A5:D5").Copy .Cells(nextRow, "D")
Worksheets("Sheet1").Range("X4:Z4").Copy .Cells(nextRow, "H")
End With
End Sub
Regarding your second suggestion: Just don't do it.
Quick answer:
Use Worksheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial SkipBlanks = False
Reference from MSDN:
SkipBlanks True to have blank cells in the range on the Clipboard not
be pasted into the destination range. The default value is False.
However, using Select is not considered good practice. Consider reading this for more information. For copy-pasting ranges, I cannot recommend more Chip Pearson's page.
Demo:
Sub test()
Dim LastRow As Long Dim arCopy() As Variant
Dim rDest As Range
With Sheet2 ' --> Qualify the ranges
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1 End With
arCopy = Sheet1.Range("A2:K2").Value
Set rDest = Sheet2.Cells(LastRow, "A")
Set rDest = rDest.Resize(1, UBound(arCopy, 2))
rDest.Value = arCopy
End Sub
Sheet1:
Sheet2 before:
Sheet2 After:
The above has the added benefit that you do not need to worry about Blank cells, as they are copied by default.
I hope this helps!
EDIT (addressing comments)
It is true that since SkipBlanks = False by default, your PasteSpecial does not skip blanks. Are you sure your cells are indeed blank and do not appear to be blank? You can make a quick check with the ISBLANK() function. If SkipBlanks appears to be working only some times, then there is certainly something different with respect to the cells it is applied to.
With ... End With: This is a shortcut construct that enhances readability. Basically, a block of methods or properties that are under the same object, such as
Sheet1.Range("A1")="Rob"
Sheet1.Copy("A2")
Sheet1.Rows.Count
can be written as
With Sheet1
.Range("A1") = "Rob"
.Copy("A2")
.Rows.Count
End With
This enhances readability
Your second suggestion
can we assign some value for e.g. NULL or 0 to those blank cells, so
that the new response can be stored in new row.
In principle, this is possible. However, you should identify which cells are "blank", and we already know that one method that does not skip blanks does not appear to work, so identifying blank cells and substituting them is a bit of a catch 22. In other words, if we knew how to find these "blank" cells so that we assign them NULL or 0, then SkipBlanks would had taken care of them in a more elegant way (because it is designed to do exactly this).
I put together a VBA code to take the values off a form on one worksheet and insert them into another worksheet without the blank cells inbetween, then clear the original form.
However, I run into the error "Runtime Error 1004: Command cannot be used on multiple selections" and cannot figure out what is causing it. After a little research, it seems that saving and reopening the workbook makes this error go away, but not always.
Any ideas?
Sub DataEntry()
'--- Find rows that contain any value in column G or H and copy them
Dim cell As Range
Dim selectRange As Range
For Each cell In ActiveSheet.Range("G3:H90")
If (cell.Value <> "") Then
If selectRange Is Nothing Then
Set selectRange = cell
Else
Set selectRange = Union(cell, selectRange)
End If
End If
Next cell
selectRange.EntireRow.Select
selectRange.EntireRow.Copy
'Paste copied selection to the worksheet 'Data' on the next blank row
Sheets("Data").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial _
Paste:=xlPasteValues
'Delete content of rows after copy and paste
Union(Range("G3:G150"), Range("H3:H150")).ClearContents
The problem seems to be that the EntireRow property is becoming a variant and not a range. I initially tried to fix this by just declaring a variable as a Range, but this didn't work either. However, by doing the original Union on rows instead of cells, I was able to get this to work.
Sub DataEntry()
'Find rows that contain any value in column G or H and copy them
Dim cell As Range
Dim selectRange As Range
Dim rowRange As Range
For Each cell In ActiveSheet.Range("G3:H90")
If (cell.Value <> "") Then
If selectRange Is Nothing Then
Set selectRange = cell.EntireRow
Else
Set selectRange = Union(cell.EntireRow, selectRange)
End If
End If
Next cell
'No need to select anything here, just copy.
selectRange.Copy
.....
I'm not entirely sure why this is happening, but this fixed it for me.
EDITED because the original fix did not work.
I want to use an If statement where if the value of a cell doesn't exist in a range then the If statement is true and the action of copying cells into a different worksheet is carried out. The section of code i'm having trouble with is -
If (Value < Date And CompletedValue = "") And (Cells(Examrow, 1).Value <> SummarySheet.Range(Cells(3, 1), Cells(100, 1)).Value) Then
The code worked fine without the And Cells(Examrow, 1).Value <> SummarySheet.Range(Cells(3, 1), Cells(100, 1)).Value) Then section so i figure this is where i'm going wrong.
It should look at the cell (Examrow, 1), get the value and then compare it to all of the cells in range A3:A:100 in the worksheet SummarySheet. If the value is not already in the range specified, then the if statement should do its thing.
Any Ideas?
EDIT:
The error message i get is:
Error Message
Edit after you added the error message:
The someWorksheet.Range method takes two arguments in the form of ranges. These ranges have to be on the worksheet someWorksheet. If you use Cells(3, 1), you don't tell VBA on which sheet the cell is so it guesses that you mean the ActiveSheet. If ActiveSheet is not someWorksheet you will get the error because the Range method of someWorksheet cannot deal with ranges from another worksheet. The answer is obviously to specify the sheet of Cells(3, 1) and Cells(100, 1):
SummarySheet.Range(SummarySheet.Cells(3, 1), SummarySheet.Cells(100, 1))
If you are hardcoding it anyway, you could also just use
SummarySheet.Range("A3:A100")
This obviously also goes for your other cell references.
However you will receive a new error after that because you cannot compare a single value to an array. You either have to loop through all the cells of the range or use the built-in .Find method:
someRange.Find(someValue)
will return the cell where someValue is first found or Nothing, if it is not found. So you just need to check if the above Is Nothing:
If SummarySheet.Range("A3:A100").Find(Cells(Examrow, 1).Value) Is Nothing Then
You should set the other options to suit your needs because they could be saved from a previous search.
This could look something like this:
Dim foundCell As Range 'to keep the If condition readable
Set foundCell = SummarySheet.Range("A3:A100").Find( _
What:=yourValue, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
MatchCase:=True)
If (.....) And foundCell Is Nothing Then
I am copying a value from one workbook to another and, when I paste it, I need the value to link back to its original source. I got it to work that the cell hyperlinks. However, I'm pasting into a variable cell, so it keeps pasting in the wrong location. Does anyone know how to make where I put stars ** below refer to the active cell?
Dim rng, clm As Range
With ActiveWindow
Set rng = Cells(ActiveCell.Row)
Set clm = Cells(ActiveCell.Column)
rng.Activate
clm.Activate
End With
With ActiveCell
Selection.PasteSpecial paste:=xlPasteValues
End With
With ActiveCell
.Hyperlinks.Add Anchor:=.Range(**rng, clm**), Address:=FilePath, ScreenTip:="The screenTIP", TextToDisplay:=FilePath
End With
Try the following instead of the second With ActiveCell:
With ActiveSheet
.Hyperlinks.Add Anchor:=ActiveCell, Address:=FilePath, ScreenTip:="The screenTIP", TextToDisplay:=FilePath
End With