I have a small puzzle. Im using cells "K6" and "L6" as imputs (for scaning the barcode). When I select cell "K6" and scan the barcode the cell "O6" is becoming from value "0" to value "1" (by formula "=IF(K6>0,1,0)").
Im using cell "O6" (when is grater then "0") as a triger for "Sub (ByVal target As Range)"
This Sub call marco "Nasklad" which copy and paste "K6" value to sheet2 (IN_OUT) column "A" first blank. After it call macro "Clear" which select sheet1 (Sklad) and clear cell "K6".
Whole process working fine, I scan a barcode, code is copied to another sheet and I can scan another code and so on.
Sub worksheet_change(ByVal target As Range)
Set target = Range("O6")
If target.Value > 0 Then
Call Nasklad
End If
End Sub
Sub Nasklad()
Sheets("Sklad").Select
Range("K6").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("IN_OUT").Select
ActiveSheet.Range("A1").End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Call clear
End Sub
Sub clear()
Sheets("Sklad").Select
Range("K6").Select
Selection.ClearContents
End Sub
Now the catch, when I tried duplicate serie of commands for cell "K6" to work with cell "L6", then nothing happedn.
It looks like "Sub worksheet_change2(ByVal target As Range)" is not working. When I imput something to "L6" value in "P6" become "1" (by formula "=IF(L6>0,1,0)" and this time trigger dont run the Sub and I dont know why.
Sub worksheet_change2(ByVal target As Range)
Set target = Range("P6")
If target.Value = 0 Then
Call Vysklad
End If
End Sub
Sub Vysklad()
Sheets("Sklad").Select
Range("L6").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("IN_OUT").Select
ActiveSheet.Range("B1").End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Call clear2
End Sub
Sub clear2()
Sheets("Sklad").Select
Range("L6").Select
Selection.ClearContents
End Sub
Did I miss something?
Thanks for helping
Thank you #BigBen and #urdearboy, this help me and I've changed the Sub worksheet_change(ByVal target As Range) to
Sub worksheet_change(ByVal target As Range)
Set target = Range("O6")
Set target2 = Range("P6")
If target.Value > 0 Then
Call Nasklad
End If
If target2.Value > 0 Then
Call Vysklad
End If
End Sub
Related
For example, if in the range of A:A only cell A8 change then copy D4:D8 and paste it as value in sheet "ADP" at the same place i.e. D4:D8.
For that I have tried the following macro
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.range = "A:A" Then
Call copy_paste_as_value
End If
End Sub
Sub copy_paste_as_value()
Range("d4").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("ADP").Activate
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("C4").Select
Application.CutCopyMode = False
End Sub
I want to copy only that data against which cell value changes, but it copies the whole table to another sheet.
main issue for me is to figure out which cell changed and copy data from that column only from which cell value changed.
here, it's to be noted that data should be copied only if there is change in range A:A, if change in any other cell than copy paste not required.
any help will be appriciated.
thank you.
Assuming the relative range is consistent, try this
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
If Target.Column = 1 And Target.Row > 4 Then
Set r = Target.Offset(-4, 3).Resize(5)
Worksheets("ADP").Range(r.Address).Value = r.Value
End If
End Sub
You could try:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim wsSou As Worksheet, wsDes As Worksheet
'Set the worksheets to avoid conflicts
Set wsSou = Target.Worksheet
Set wsDes = ThisWorkbook.Worksheets("ADP")
If Not Intersect(Target, Range("A:A")) Is Nothing And Target.Count = 1 Then
wsDes.Range(wsDes.Cells(Target.Row, 4), wsDes.Cells(Target.Row, 9)).Value = wsSou.Range(wsSou.Cells(Target.Row, 4), wsSou.Cells(Target.Row, 9)).Value
End If
End Sub
I have a count down timer in excel and as it counts down i would like to copy and paste range of cells to another, based on 60 mins and minute to the end i have written the time i would like the macro to do this in j1 and input the ranges but i cant get it to work.
Sub MyMacro(my_macro)
If Cells(4, 6) = j1 Then
Range("g9:G64").Select
Selection.Copy
Range("L9:l64").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
If Not apllication.insersect(Range(j1), Range(target.Address)) Is Nothing
Then
End Sub
any help would be greatly appreciated
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("K4")) Is Nothing Then
If Range("K4") < Range("J1") Then
Range("G9:G64").Copy
Range("L9").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
End If
End Sub
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
I'm attempting to get a macro(button click) to paste a value into another sheet if the value is not a formula. I'm not getting any errors with the below but the function won't fire. Thank you in advance for your help!
Sub Update_Numbers(ByVal Target As Range)
' Update_Numbers Macro
'
' Keyboard Shortcut: Ctrl+j
On Error GoTo Safe_Exit
Application.EnableEvents = False
Select Case Target.Address(0, 0)
Case Sheets("Wage Run").Range("B7")
If Target.HasFormula = False Then _
Sheets("wage run").Range("B7").Copy
Sheets("With Changes").Select
Range(Application.WorksheetFunction.Index(Sheets("With Changes").Range("E2:AB138"), Application.WorksheetFunction.Match(Sheets("Wage Run").Range("D1"), Sheets("With Changes").Range("A2:A138"), 0), 1)).Select
ActiveSheet.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Select
Safe_Exit:
Application.EnableEvents = True
End Sub
EDIT: Changed with the below suggestions, but it still won't fire.
Sub Update_Numbers(ByVal Target As Range)
With Sheets("wage run")
' Update_Numbers Macro
'
' Keyboard Shortcut: Ctrl+j
On Error GoTo Safe_Exit
Application.EnableEvents = False
Select Case Target.Address(0, 0)
Case "B7"
If Target.HasFormula = False Then
Sheets("wage run").Range("B7").Copy
Sheets("With Changes").Select
Range(Application.WorksheetFunction.Index(Sheets("With Changes").Range("E2:AB138"), Application.WorksheetFunction.Match(Sheets("Wage Run").Range("D1"), Sheets("With Changes").Range("A2:A138"), 0), 1)).Select
ActiveSheet.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
End Select
Safe_Exit:
Application.EnableEvents = True
End Sub
In addition to #Scott Craner's comment above: Note that the "If-Then" construct doesn't need any corresponding "End If" when you have only one statement on one line following "Then". But when the If construct contains more than one statement, as in your case, the code block must end with "End If". You have a line continuation symbol ( _) immediately after "Then". Try removing this and include an End If statement instead, like this:
Select Case Target.Address(0, 0)
Case Sheets("Wage Run").Range("B7")
If Target.HasFormula = False Then
Sheets("wage run").Range("B7").Copy
Sheets("With Changes").Select
Range(Application.WorksheetFunction.Index(Sheets("With Changes").Range("E2:AB138"), Application.WorksheetFunction.Match(Sheets("Wage Run").Range("D1"), Sheets("With Changes").Range("A2:A138"), 0), 1)).Select
ActiveSheet.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
End Select
In addition to my comments above, here is a very minimal example that seems to do what you are asking for, but without any other context. It works on a workbook with (at least) two sheets. Maybe useful as a starting point.
Sub Macro1()
'
' Macro1 Macro
'
' Paste a value into another sheet if the value is not a formula.
Dim sourcecell As Range
Dim targetcell As Range
Set sourcecell = Sheets(1).Range("D8")
Set targetcell = Sheets(2).Range("D8")
If Not sourcecell.HasFormula Then targetcell = sourcecell
End Sub
I have an If statement that runs on the change of a cell. This part works fine. However, when it runs the macro, for some reason it adds is about 40 extra lines. I'v used the breakpoint and discovered that the lines are added in after the the paste special. Can anyone tell me why?
Thanks in advance.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$AG$4" Then
Call CapEx_Copy_Paste_Delete
End If
End Sub
Sub CapEx_Copy_Paste_Delete()
'
' CapEx_Copy_Paste_Delete Macro
'
'
Rows("11:11").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B4:AG4").Select
Selection.Copy
Range("B11").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AG4").Select
Selection.ClearContents
Range("B4:E4").Select
Selection.ClearContents
Range("H4:I4").Select
Selection.ClearContents
Range("L4:M4").Select
Selection.ClearContents
Range("P4:Q4").Select
Selection.ClearContents
Range("T4:U4").Select
Selection.ClearContents
Range("X4:Y4").Select
Selection.ClearContents
Range("Z4").Select
Selection.ClearContents
Range("AA4").Select
Selection.ClearContents
Range("AC4").Select
Selection.ClearContents
Range("AD4").Select
Selection.ClearContents
Range("B4").Select
End Sub
Does this work any better??:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$AG$4" Then
Application.EnableEvents = False
Call CapEx_Copy_Paste_Delete
Application.EnableEvents = True
End If
End Sub
Here is the neater version of your code. It's likely all that use of Select isn't helping your problems:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$AG$4" Then
Application.EnableEvents = False
Call CapEx_Copy_Paste_Delete
Application.EnableEvents = True
End If
End Sub
Sub CapEx_Copy_Paste_Delete()
Dim ws As Worksheet
Dim arrRanges As Variant, v As Variant
'set this as the worksheet you want to update
Set ws = ThisWorkbook.Worksheets("Sheet1")
'set this as the ranges you want to clear
arrRanges = Array("AG4", "B4:E4", "H4:I4", "L4:M4", "P4:Q4", "T4:U4", "X4:Y4", "Z4")
With ws
.Rows("11:11").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.Range("B4:AG4").Copy
.Range("B11").PasteSpecial Paste:=xlPasteValues
For Each v In arrRanges
.Range(v).ClearContents
Next v
End With
End Sub
Updated to include Gary's Student's suggestion - all credit goes to him for suggesting you disable events in your first sub