Trying to keep only the values not the formulas in the cells if the cell is="Yes"
Here is my code:
Sub Fixed()
Dim cell As Range
For Each cell In Range("Q4799:Q4825")
On Error Resume Next
If cell.Value = "Yes" Then
cell.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.Save
End If
Next cell
End Sub
I ran it for cells that are currently some formulas they are like this:
=INDEX(Copy!B:B,MATCH(Manifest!A4800,Copy!A:A,0))
And it look like this
However, It seems to be performing actions regardless what that cell value is. So, it is currently doing things for every cells from Q4799:Q4825 even if it is not "Yes".
How can I fix it?
Rewritten as,
Sub Fixed()
Dim cell As Range
On Error Resume Next
For Each cell In Range("Q4799:Q4825")
If cell.Value = "Yes" Then
cell.Value = cell.Value
End If
Next cell
ActiveWorkbook.Save
End Sub
Alternate for all text based (non-numerical, non-boolean, non-error) values returned from a formula.
Sub Fixed()
with Range("Q4799:Q4825").specialcells(xlCellTypeFormulas, xlTextValues)
.Value = .Value
end with
ActiveWorkbook.Save
End Sub
Related
I am trying to find the next blank cell in column N in order to select and copy the vale in the same row but in column I after autofiltering column B.
My code seems to find the next blank cell but doesn't take the filter into consideration finding the blank cell in rows not included in the filter.
Hope this makes sense
Edit: Apologies about the shite code, I typically recycle and string it all together etc.
Sub Replanning_Lasers()
startofloop:
Dim Orderbook As String
Dim Supply As String
Orderbook = Sheet25.Range("C14")
Supply = Sheet25.Range("D14")
If Orderbook > Supply Then GoTo endofloop
***Sheets("List").Select
Range("$B$4:$BN$1533").AutoFilter Field:=3, Criteria1:="LASER"
NextFree = Range("N5:" & Rows.Count).Cells.SpecialCells(xlCellTypeBlanks).row
Range("I" & NextFree).Select***
Selection.Copy
Sheets("Planning").Select
Range("C9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Call BUT_Planning_reset
Call BUT_Planning_Find_First
Range("M9").Select
Selection.Copy
Sheets("List").Select
Range("N" & NextFree).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
GoTo startofloop
endofloop:
End Sub
Thanks
Maybe try something like this:
Sub Replanning_Lasers()
Dim wsList As Worksheet, wsPlan As Worksheet, rngData As Range, rngBlanks As Range
Set wsList = ThisWorkbook.Sheets("List") 'Use variables for worksheets
Set wsPlan = ThisWorkbook.Sheets("Planning") ' to avoid repetition
Set rngData = wsList.Range("B4:BN1533")
rngData.AutoFilter Field:=3, Criteria1:="LASER"
On Error Resume Next 'ignore error if no visible blank cells
'find any visible blank cells in ColN of the filtered data
Set rngBlanks = rngData.EntireRow.Columns("N"). _
SpecialCells(xlCellTypeVisible). _
SpecialCells(xlCellTypeBlanks)
On Error GoTo 0 'stop ignoring errors
If rngBlanks Is Nothing Then Exit Sub 'no visible blanks
For Each c In rngBlanks.Cells 'process each blank cell in turn
If Sheet25.Range("C14") > Sheet25.Range("D14") Then
Msgbox "supply breach"
Exit For 'Orderbook > Supply ?
End If
wsPlan.Range("C9").Value = c.EntireRow.Columns("I").Value 'no need for copy/pastespecial
BUT_Planning_reset 'use of Call is deprecated...
BUT_Planning_Find_First
c.EntireRow.Columns("N").Value = wsPlan.Range("M9").Value
Next c
End Sub
I have a problem with the autofill function. I want to use the macro to fill in the date until there is nothing left in B. The problem is that there are some gaps there. Can I change the code so that it fills up to the last line in B. I tried it with the code below. However, it does not work.
Sub fill()
Sheets("Table1").Select
Columns("C:C").Select
Selection.Insert Shift:=xlToRight
Range("C2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""",R[-1]C,RC[-1])"
ActiveCell.Select
Dim last As Long
Range("C2").Select
Range(Selection, Selection.End(xlToRight)).AutoFill Destination:=Range("C2:C" & last)
Selection.End(xlDown).Select
Selection.ClearContents
ActiveCell.Offset(-1, 0).Range("A1").Select
Range(Selection, Selection.End(xlUp)).Select
Selection.Copy
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("C:C").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("A1").Select
End Sub
You do not need such a lengthy process. You can do it in just couple of lines. For example
rng.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
Here is an example. Assuming that your range is from C2 onwards as shown below.
Try this code
Option Explicit
Sub Sample()
Dim ws As Worksheet
Set ws = Sheets("Table")
Dim lRow As Long
With ws
lRow = .Range("C" & .Rows.Count).End(xlUp).Row
Dim rng As Range
Set rng = .Range("C3:C" & lRow)
Dim visibleCells As Range
On Error Resume Next
Set visibleCells = rng.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If Not visibleCells Is Nothing Then
visibleCells.FormulaR1C1 = "=R[-1]C"
End If
End With
End Sub
In Action
Worth a Mention
Also avoid using Select/Selection/Activecell etc. You may want to read up on How to avoid using Select in Excel VBA
You do not need VBA to achieve what you want. You can achieve the same using few clicks.
NON VBA Method
Select your range. In this case C3:C13
Press CTRL + G to bring up the Go To dialog box
Click Special button
Select the Blanks radio button and click OK.
In the Formula bar type =C2 and press CTRL + ENTER key and you are done
In Action
The code below is working as designed, with one exception:
Range b4:b100 are lookup formulas from another sheet where everything below B34 is a #value! error where I'm specifying =iferror(formula),""
It is copying the resulting "" and so the next time I it runs, it begins to paste on the target sheet on B101 rather than B35.
How can I specify "Do not use any space on the target sheet with blanks where formulas existed on the source sheet"?
Sub COPYTOSAVEDWORK()
Sheets("FORMULAWORKED").Range("B4:Q100").Select
Selection.Copy
Sheets("WORKED_CLAIMS").Cells(Rows.Count, "A").End(xlUp).Offset(1). _
PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, _
SkipBlanks:=True, Transpose:=False
Exit Sub
End Sub
You can call .Value = .Value on the pasted range, and that will eliminate cells with the empty string:
Sub Test()
Dim formulaRng As Range
Set formulaRng = ThisWorkbook.Sheets("FORMULAWORKED").Range("B4:Q100")
With ThisWorkbook.Sheets("WORKED_CLAIMS")
Dim nextRow As Long
nextRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
formulaRng.Copy
.Cells(nextRow, "A").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
With .Cells(nextRow, "A").Resize(formulaRng.Rows.Count, formulaRng.Columns.Count)
.Value = .Value
End With
End With
End Sub
A value transfer as per #BigBen would work great, but you seem to want to copy/paste numbers and NumberFormat. Maybe something like the below would work:
Sub Test()
Dim rng As Range
Dim arr As Variant
With Sheets("FORMULAWORKED")
.Range(Join(Filter(.[TRANSPOSE(IF(B4:B100<>"","B"&ROW(B4:B100)&":Q"&ROW(B4:B100),"|"))], "|", False), ",")).Copy
Sheets("WORKED_CLAIMS").Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With
End Sub
I have to select specific row from so many rows and copy paste to another sheet but I don't want to specified value of cell if it takes value from particular cell
my code is
Sub Macro3()
Dim rngG As Range
Dim cell As Range
Sheets("Urban-Ward_vise").Select
Set rngG = Range("G1", Range("G65536").End(xlUp))
For Each cell In rngG
If cell.Value = "BAVLA" Then
cell.EntireRow.Copy
Sheets("Sheet1").Select
ActiveCell.Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Next cell
Selection.End(xlUp).Select
End Sub
I want to select rows from Urban-Ward_vise and paste in sheet1
in
If cell.Value = "BAVLA" Then
I don't want put value "BAVLA" but I want to read the value from sheet1 cell like c5 so please help
Do you mean something like this?
It would be worth you reading how to avoid Select.
Sub Macro3()
Dim rngG As Range
Dim cell As Range
With Sheets("Urban-Ward_vise")
Set rngG = .Range("G1", .Range("G" & Rows.Count).End(xlUp))
End With
For Each cell In rngG
If cell.Value = Sheets("Sheet1").Range("C5").Value Then 'specify sheet name and cell here
cell.EntireRow.Copy
Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
End If
Next cell
End Sub
This is what I have so far. I need a sub to copy a group of cells and paste their values on the next empty cell available. The error I'm getting is in selecting that first available cell. Any thoughts?
Dim workline As Integer
Sub Test()
With ActiveSheet
workline = 11
While .Cells(workline, 2) <> Empty
workline = workline + 1
Wend
End With
Range("B3:CH9").Select
Selection.Copy
range(workline,2) .Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Message = MsgBox("Data copied succesfully", vbInformation + vbOKOnly, "Aecon Mining")
End Sub`
Not tested in Excel, but should work, or at least pointing you to the right direction:
Range("B3:CH9").Copy
Range("B2").end(xlDown).offset(1,0).paste 'first available cell
And stop using those .Select and selection everywhere, they are a total waste of time.