A simple code to move data with a Button

[gnaske]

Can anybody please help me with a simple button code to move data from D:K to Q:X.

- If D: is empty, jump to Q:X and move the data.
- If Q: is empty, jump to D:K and move the data.
- If both D: and Q: is empty, do nothing and jump out of the code.

Look at the attached file too.

Thank you.

Ib

http://i7.tagstat.com/image09/5/df98/00hA054Zt-o.jpg

[Trebor76]

Hi gnaske,

This will do the job:


Option Explicit

Private Sub CheckBox1_Click()

'Adapted by Trebor76
'Visit my website www.excelguru.net.au (http://www.excelguru.net.au)

Application.ScreenUpdating = False

If Len(Range("D3")) + Len(Range("Q3")) = 0 Then
Application.ScreenUpdating = True
Exit Sub
ElseIf Len(Range("D3")) > 0 And Len(Range("Q3")) = 0 Then
Range("D3:K3").Copy Destination:=Range("Q3:X3")
Range("D3:K3").ClearContents
Else
Range("Q3:X3").Copy Destination:=Range("D3:K3")
Range("Q3:X3").ClearContents
End If

Range("A1").Select

Application.ScreenUpdating = False

End Sub
Private Sub CommandButton1_Click()

'Adapted by Trebor76
'Visit my website www.excelguru.net.au (http://www.excelguru.net.au)

Application.ScreenUpdating = False

If Len(Range("D23")) + Len(Range("Q23")) = 0 Then
Application.ScreenUpdating = True
Exit Sub
ElseIf Len(Range("D23")) > 0 And Len(Range("Q23")) = 0 Then
Range("D23:K23").Copy Destination:=Range("Q23:X23")
Range("D23:K23").ClearContents
Else
Range("Q23:X23").Copy Destination:=Range("D23:K23")
Range("Q23:X23").ClearContents
End If

Range("A1").Select

Application.ScreenUpdating = False

End Sub

Regards,

Robert

[gnaske]

Hi Robert.

Thank you very very much.
Just what I needed.

I hope I can get back, if I got other problems, what I probably will have :banghead:
Hmmmm.

Kind regards

Ib

[gnaske]

Hi again Robert.

Your code didn't worked in my Excel with Menu's, because of your
Application.ScreenUpdating = False
Application.ScreenUpdating = True

But using some of your code and some of one of my own code, I got it to work.
Thank you very much.

Please look the attached file too.

Kind regards

Ib

[Simon Lloyd]

His code works fine, its just the last Application.ScreenUpdating = Falsein each sub should have beenApplication.ScreenUpdating = TrueLike this
Option Explicit
Private Sub CheckBox1_Click()

'Adapted by Trebor76
'Visit my website www.excelguru.net.au (http://www.excelguru.net.au)

Application.ScreenUpdating = False

If Len(Range("D3")) + Len(Range("Q3")) = 0 Then
Application.ScreenUpdating = True
Exit Sub
ElseIf Len(Range("D3")) > 0 And Len(Range("Q3")) = 0 Then
Range("D3:K3").Copy Destination:=Range("Q3:X3")
Range("D3:K3").ClearContents
Else
Range("Q3:X3").Copy Destination:=Range("D3:K3")
Range("Q3:X3").ClearContents
End If

Range("A1").Select

Application.ScreenUpdating = True

End Sub
Private Sub CommandButton1_Click()

'Adapted by Trebor76
'Visit my website www.excelguru.net.au (http://www.excelguru.net.au)

Application.ScreenUpdating = False

If Len(Range("D23")) + Len(Range("Q23")) = 0 Then
Application.ScreenUpdating = True
Exit Sub
ElseIf Len(Range("D23")) > 0 And Len(Range("Q23")) = 0 Then
Range("D23:K23").Copy Destination:=Range("Q23:X23")
Range("D23:K23").ClearContents
Else
Range("Q23:X23").Copy Destination:=Range("D23:K23")
Range("Q23:X23").ClearContents
End If

Range("A1").Select

Application.ScreenUpdating = True

End Sub

[Trebor76]

Thanks Simon. It was getting late here in Aus when I answered that query.

Ib - I can't image Application.ScreenUpdating would cause any issues as the command has remained the same for all versions of VBA :confused:

Anyway, I'm glad to know that we were able to get the problem sorted.

Regards,

Robert

[gnaske]

Hi Simon and Robert.

I copied/pasted the code with the Application.ScreenUpdate to each button in my menu and the code could only copy from left to right, but not from right to left.

I believe I made a mistake, when I copied the code :think: and that's why I was combining the two codes.

Anyway - I got the code working and this problem is solved in my Excel, but the Excel is not finished and kind of big for me and I'm new into this VBA coding.
Learning by trying and find it very interesting :joy:

Thank you both for your help :bow:

Please look at the attached too.

Kind regards

Ib