I try to copy data from table tblkasir to tbldafta using a button. But when I click the button the button my Excel is not responding and keeps adding the data until the last row.
Here the script of the button.
Private Sub cmdSimpan_Click()
SimpanNota
SimpanDafta
End Sub
Sub SimpanNota()
ActiveWorkbook.Sheets("kasir").Activate
Sheets("kasir").Range("Q4").Select
Do
If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True
ActiveCell.Value = Sheets("kasir").Range("N3").Value
End Sub
Sub SimpanDafta() 'this is the script that keep looping
ActiveWorkbook.Sheets("daftar transaksi").Activate
Sheets("daftar transaksi").Range("tbldafta[[nomor transaksi]:[jumlah]]").Select
Do
If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True
Sheets("daftar transaksi").Select
Sheets("kasir").Range("tblkasir[[nomor transaksi]:[jumlah]]").Copy Destination:=Sheets("daftar transaksi").Range(Selection, Selection.End(xlDown))
ActiveCell.Offset(1, 1).Range("C9") = Sheets("daftar transaksi").Range(Selection, Selection.End(xlDown))
Application.CutCopyMode = False
Sheets("kasir").Range("tblkasir[[nomor transaksi]:[jumlah]]").ClearContents
Sheets("kasir").Range("K4").ClearContents
End Sub
please help.
Not only is it advised to avoid Select while copying and pasting, but you also seem to be reinventing the "Select Current Region" feature :-)
Just for giving you an idea about this, I've made this very simple macro, using "Select current region" as a simpler way to handle entire tables:
(I've created two sheets, called "TblSource" and "TblDest")
Sheets("TblSource").Range("A1").CurrentRegion.Copy
Sheets("TblDest").Select
Range("A1").Select
ActiveSheet.Paste
Im using this way to do it. thank you for your recommendation...
'COPY DATA DARI SHEET KASIR KE SHEET DAFTAR TRANSAKSI
Sub SimpanDafta()
'PILIH SHEET YANG AKAN DICOPY, YAITU SHEET : KASIR
ActiveSheet.ListObjects("tblkasir").ListColumns(2).DataBodyRange.Resize(, 9).Select
Selection.Copy
'PILIH SHEET YANG AKAN DIPASTE, YAITU SHEET : DAFTAR TRANSAKSI
Sheets("daftar transaksi").Select
Do
If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True
ActiveSheet.Paste
End Sub
Related
I recorded a macro to better understand my process. This macro is shown below in the first part. The second part is my attempt to make this thing faster.
Current Sequence of Events
Insert asset name in cell D3, in a tab titled "Live" (cell D3 is a dropdown list with 50+ assets - more on this in next section titled "Steps We Can Improve")
Calculate new asset by using Application.CalculateFull
Wait until the "Live" tab is done calculating to move to next line of code
Wait 15 seconds (more on this in next section)
Copy the newly iterated data in the "Live" tab
Create a new worksheet titled with the asset's name
Paste the data from the "Live" tab as values into the newly created worksheet
Repeat steps 1-7 until all assets have been calculated
Steps to Improve
instead of inserting an asset name in cell D3, which requires a lot of code, I would like to loop through the list found within cell D3 (a data validation list which sources asset names from a master list on another worksheet).
I added time to the code because I thought the model was not fully iterating for certain assets. This was wrong - it never iterated correctly with the addition of time. So, it is likely a formula error? The formula is listed below, and it is showing a #VALUE error for roughly 20 assets - but only when I run the macro. Outside of the macro, this formula populates correctly.
Sub SlowMACROv3()
' Turns off screen updating and auto calcs which helps to speed macro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
' Turns off screen updating and auto calcs which helps to speed macro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Sheets("Live").Select
Range("D3").Select
ActiveCell.FormulaR1C1 = "309"
Application.Calculate
If Not Application.CalculationState = xlDone Then DoEvents
Application.Wait (Now + TimeValue("0:00:15"))
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Live").Select
Sheets("Live").Copy Before:=Sheets(1)
Range("D3").Select
ActiveCell.FormulaR1C1 = "310"
Application.Calculate
If Not Application.CalculationState = xlDone Then DoEvents
Application.Wait (Now + TimeValue("0:00:15"))
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
' Turns on screen updating and auto calcs
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
My second attempt works, but the code is just as long. Also a formula throws an error for some assets and can be found at the very bottom.
Sub SlowishMACROv1()
' Turns off screen updating and auto calcs which helps to speed macro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
' Cycle all assets and create new worksheets as values macro
Sheets("Live").Copy Before:=Sheets(1)
Range("D3").FormulaR1C1 = "309"
Application.Calculate
If Not Application.CalculationState = xlDone Then DoEvents
Range("A1:XFD1000").Value = Range("A1:XFD1000").Value
Sheets("Live").Copy Before:=Sheets(1)
Range("D3").FormulaR1C1 = "310"
Application.Calculate
If Not Application.CalculationState = xlDone Then DoEvents
Range("A1:XFD1000").Value = Range("A1:XFD1000").Value
' Turns on screen updating and auto calcs
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Formula: =+IF(INDEX('Reversion Dashboard'!$I:$I,MATCH($D$3,'Reversion Dashboard'!$C:$C,0))=1,I331*(1+(RATE($E$325,,$I331,-('Reversion Schedule'!$K$19)))),"")
This formula works in the "Live" tab except for assets that trigger the =1 portion within the IF True section, whenever the macro is run. Why does this formula work every time we switch to a different asset, but not when I run the macro?
Am tempted to suggest you close this question and start again as the comments are long. Read [ask] and [mcve] and perhaps post a screenshot as remember that none of us know anything about your set up.
However, see if this code broadly does what you want - it's not entirely clear as Ibo says.
Sub x()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim r As Range, ws As Worksheet
For Each r In Worksheets("Asset Dashboard").Range("C6:C570") 'go through each cell in DV list
If Len(r) > 0 Then 'only do something if cell not empty
Worksheets("Live").Range("D3").Value = r.Value 'transfer value to D3 of Live
Application.Calculate
Set ws = Worksheets.Add 'add new sheet
Worksheets("Live").UsedRange.Copy
ws.Range("A1").PasteSpecial xlValues 'copy values only from Live to new sheet
End if
Next r
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
I have a checkbox which copies 5 cells of a address into 5 cells below if the project address is the same as the correspondence address.
here is the code I have:
Sub copy_address()
'
' copy_address Macro
'
Range("D5:G5").Select
Selection.Copy
Range("D11:G11").Select
ActiveSheet.Paste
Range("D6:G6").Select
Application.CutCopyMode = False
Selection.Copy
Range("D12:G12").Select
ActiveSheet.Paste
Range("D7:G7").Select
Application.CutCopyMode = False
Selection.Copy
Range("D13:G13").Select
ActiveSheet.Paste
Range("D8:G8").Select
Application.CutCopyMode = False
Selection.Copy
Range("D14:G14").Select
ActiveSheet.Paste
Range("F9:G9").Select
Application.CutCopyMode = False
Selection.Copy
Range("F15:G15").Select
ActiveSheet.Paste
SendKeys "{ESC}"
ActiveSheet.Range("D17").Select
End Sub
But what it does not do is undo the copy and paste when de-selected. In fact it carries out the copy and paste operation weather the box is ticked or un-ticked.
There is no mention in your code of any checkbox or its current state (aka .Value). Typically, after putting an ActiveX checkbox on the worksheet, you would use Design Mode and right-click it for the View Code command.
Once on the worksheet's code sheet in the VBE, modify the on-click handler to something like this.
Private Sub CheckBox1_Click()
If CheckBox1.Value Then
Range("D5:G8").Copy Destination:=Range("D11")
Range("F9:G9").Copy Destination:=Range("F15")
Else
Range("D11:G14").ClearContents
Range("F15:G15").ClearContents
End If
End Sub
Or you can try this if you want to keep the already assigned copy_address sub.
Sub copy_address()
'
' copy_address Macro
If ActiveSheet.Shapes("Check Box 1").ControlFormat.Value = 1 Then
ActiveSheet.Range("D5:G8").Copy Destination:=ActiveSheet.Range("D11:G14")
ActiveSheet.Range("F9:G9").Copy Destination:=ActiveSheet.Range("F15:G15")
Else
ActiveSheet.Range("D11:G15").ClearContents
End If
End Sub
I am looking for a way to copy and paste text from one sheet to another when I tick a form control checkbox and to delete it when I uncheck it. At the moment the macro I have written does nothing, it doesn't come up with any errors it just doesn't work. What I have so far is:
Sub CheckBox3_Click()
Application.ScreenUpdating = False
If CheckBox3 = True Then
Sheets("Data Sheet").Activate
Range("B1").Select
Selection.Copy
Sheets("Sheet1").Select
Range("C1").Select
ActiveSheet.Paste
Application.ScreenUpdating = True
End If
If CheckBox3 = False Then
ActiveSheet.Range("C1").Select
Selection.Delete
End If
End Sub
Any help would be appreciated, thanks.
To overcome your Runtime error please change your code to
ActiveSheet.Range("B1").Select
and do the same for the target range C1
However, the much more elegant way is to get rid of Select and Activate all together by using VBA rather than "macro recording" ... work with Range objects which will simplify your code, you avoid messy screen jumps etc ...
Private Sub CheckBox1_Click()
Dim SrcRange As Range, TrgRange As Range
Set SrcRange = Worksheets("Data Sheet").[B1]
Set TrgRange = Worksheets("Sheet1").[C1]
If CheckBox1 Then
TrgRange = SrcRange
Else
TrgRange = ""
End If
End Sub
I have a group of cells B32 till R32 length and B32 to B51 breadth. I want to keep this block hidden at the start when the sheet is opened. I have named this block as 'Analysis'.
There is a button in the sheet. When the button is pressed, I want to unhide that block. I am new to Excel Vba. I would like to know the syntax/code for doing this operation.
Thanks in advance.
Ananda
You cant just hide an area like MattCrum has mentioned.
You have 3 choices as far as I am concerned
Now, just make sure you have something(data - not empty cells) in the Range 32:51 and your main sheet is either called Sheet1 or change Sheet1 in the code to suit your worksheets name
1)
in VBE ( Visual Basic Editor ) double click ThisWorkbook in the project explorer and paste this code
Private Sub Workbook_Open()
ThisWorkbook.Sheets("Sheet1").Rows(32 & ":" & 51).hidden = True
End Sub
Right click on the folder Modules and Insert a new Module, then paste this code
Sub unhide()
ThisWorkbook.Sheets("Sheet1").Rows(32 & ":" & 51).hidden = False
End Sub
Now, add a button on the spreadsheet, right click and assign macro called unhide to it.
Save changes and save your workbook as *.xlsm file
Notice when you open the workbook now, rows 32 to 51 are hidden. Clicking the button will unhide them.
2) You can change the font color to white to "hide" the contents.
Follow step 1, and replace
ThisWorkbook.Sheets("Sheet1").Rows(32 & ":" & 51).hidden = True
with this
ThisWorkbook.Sheets("Sheet1").Range("B32:R51").Font.Color = RGB(255, 255, 255)
and the code in the Module ( the unhide subroutine )with
ThisWorkbook.Sheets("Sheet1").Range("B32:R51").Font.Color = RGB(0, 0, 0)
Now, everything works similar to step 1 except your are "hiding"(changing) the font color instead of hiding rows. Not a great approach, but if it works for you then cool
3) Follow step 1 and replace the code under ThisWorkbook with
Option Explicit
Private Sub Workbook_Open()
Application.ScreenUpdating = False
Set ws = ThisWorkbook.Sheets("Sheet1")
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "hiddenSheet"
Set hs = ThisWorkbook.Sheets(Worksheets.Count)
hs.Visible = xlSheetHidden
ws.Range("B32:R51").Select
Selection.Copy
With hs
.Activate
.Range("B32").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End With
ws.Activate
ws.Rows(32 & ":" & 51).Delete
Application.ScreenUpdating = True
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call deleteHidden(Worksheets.Count)
End Sub
And the code in the Module1 with
Option Explicit
Public ws As Worksheet, hs As Worksheet
Sub unhide()
With hs
.Activate
.Rows("32:51").Select
Selection.Copy
End With
With ws
.Activate
.Rows("32:32").Select
Selection.Insert Shift:=xlDown
End With
End Sub
Sub deleteHidden(num&)
Application.DisplayAlerts = False
Worksheets(num).Delete
Application.DisplayAlerts = True
Set hs = Nothing
End Sub
I want to paste link from one sheet to another
Range("A1:D1").Select
Range("D1").Activate
Selection.Copy
Sheets("Sheet2").Select
ActiveSheet.Paste Link:=True
However, the code would make the sheet to switch to Sheet2 from Sheet1. Is there anyway that I could paste the link without switching the sheet?
Thanks.
This will work:
ThisWorkbook.Worksheets("Sheet2").Range("D1").Formula = "=Sheet1!D1"
I guess this is what you are trying?
Sub Sample()
Dim i As Long
For i = 1 To 4
Sheets("Sheet2").Cells(1, i).Formula = "=Sheet1!" & _
Split(Cells(, i).Address, "$")(1) & "1"
Next i
End Sub
This code will do the same as your code snippet without changing the active sheet.
Range("A1:D1").Copy
Worksheets("Sheet2").Paste Link:=True
Note that this (and your code) will copy from the active sheet. If you want to copy from a sheet other than the active sheet, use somthing like
Worksheets("Sheet1").Range("A1:D1").Copy
Worksheets("Sheet2").Paste Link:=True
I've had the same problem just now. I just realized then that TightVNC was connected to another machine when I tried to run my code. When I closed it, the code run as usual.
Possibly this happens because some software might be taking control of your clipboard. Just close anything you don't need, like VNCs or Virtual Machines.
Your LINK desire cannot be done without selecting the sheet. But you can make the fact that it does that invisible to the eye.
Option Explicit
Sub test()
Application.ScreenUpdating = False
Sheets("Sheet1").Range("A1:D1").Copy
With Sheets("Sheet2")
.Activate
.Range("A1").Select
ActiveSheet.Paste Link:=True
End With
Sheets("Sheet1").Activate
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
You could use Application.ScreenUpdating = False and then return it to true after the paste has completed.
Example:
Application.ScreenUpdating = False
Worksheets("Sheet1").Range("D1").Copy
Worksheets("Sheet2").Activate
Range("Range You Want To Paste").Select
ActiveSheet.PasteSpecial Link:=True
Worksheets("Sheet1").Activate
Range("A Range You Want Active").Activate
Application.ScreenUpdating =true