3 Actions VBA Copy, Clear contents ("") and Shift all to left

motilulla · Nov 10, 2018

Hello,

Below example columns C:K result are by formulas, all formulas have not an outcome; in that case the formula has leaved a cell blank with (""). 

Now I need a VBA code that does 3 actions...
1-Copy values of columns C:K into M:U
2- Clear contents ("") of columns M:U
3-Shift all values to left

Book1

A

B

C

D

E

F

G

H

I

J

K

L

M

N

O

P

Q

R

S

T

U

1

2

3

4

5

n1

n2

n3

n4

n5

n6

n7

n8

n9

n1

n2

n3

n4

n5

n6

n7

n8

n9

6

2

1

2

1

7

2

1

2

1

2

8

2

1

2

1

9

1

3

1

3

10

2

3

1

2

3

1

11

2

1

2

1

12

2

3

2

3

2

13

2

1

2

1

14

1

3

1

3

15

2

1

3

1

2

1

3

1

16

1

2

1

2

1

2

1

2

17

2

3

2

3

2

18

4

1

4

1

19

2

1

2

1

2

1

2

1

20

2

1

2

1

21

2

1

2

1

2

1

2

1

22

2

1

2

1

2

1

2

1

23

3

1

3

1

24

2

1

2

1

25

6

1

6

1

26

3

2

1

3

2

1

27

2

1

2

1

2

28

1

2

1

2

29

1

2

1

2

1

2

1

2

1

30

3

2

1

3

2

1

31

6

1

6

1

32

1

3

2

1

3

2

1

33

1

2

1

2

1

34

3

1

2

1

3

1

2

1

35

1

2

1

2

1

36

2

1

2

1

2

37

3

1

2

3

1

2

38

3

1

3

1

39

2

1

2

1

2

40

1

2

1

2

1

41

3

1

2

3

1

2

42

1

2

1

2

1

2

1

2

1

43

2

1

2

1

2

1

2

1

44

2

1

2

1

45

4

1

4

1

46

4

1

4

1

47

4

1

4

1

48

3

1

2

3

1

2

49

2

3

1

2

3

1

50

4

1

4

1

51

1

2

1

2

1

52

4

1

4

1

53

2

1

2

1

54

2

1

2

1

55

1

3

1

3

1

56

1

2

1

2

1

57

2

1

2

1

58

4

1

4

1

59

5

2

5

2

60

1

2

1

2

1

2

1

2

1

Sheet8

Thank you all

Excel 2000
Regards,
Moti

KolGuyXcel · Nov 10, 2018

Check if it suites all the purpose!

Sub chk_val()
Dim l_row As Integer
Dim i As Integer, j As Integer, k As Integer
l_row = 0
k = 1
For i = 3 To 11
If l_row <= Cells(Rows.Count, i).End(xlUp).Row Then l_row = Cells(Rows.Count, i).End(xlUp).Row
Next
Range("M6:V" & l_row).ClearContents
For i = 6 To l_row
For j = 1 To 9
If Cells(i, 2 + j).Value2 <> "" Then
Cells(i, 12 + k) = Cells(i, 2 + j)
k = k + 1
End If
Next
k = 1
For j = 1 To 9
Cells(i, 22).Value2 = Cells(i, 22).Value2 & Cells(i, 12 + j).Value2 & " | "
Next
Next
End Sub

motilulla · Nov 10, 2018

KolGuyXcel said:
Check if it suites all the purpose!

Sub chk_val()
Dim l_row As Integer
Dim i As Integer, j As Integer, k As Integer
l_row = 0
k = 1
For i = 3 To 11
If l_row <= Cells(Rows.Count, i).End(xlUp).Row Then l_row = Cells(Rows.Count, i).End(xlUp).Row
Next
Range("M6:V" & l_row).ClearContents
For i = 6 To l_row
For j = 1 To 9
If Cells(i, 2 + j).Value2 <> "" Then
Cells(i, 12 + k) = Cells(i, 2 + j)
k = k + 1
End If
Next
k = 1
For j = 1 To 9
Cells(i, 22).Value2 = Cells(i, 22).Value2 & Cells(i, 12 + j).Value2 & " | "
Next
Next
End Sub

Wow!! KolGuyXcel, it is just amazing solution spot on!!

Thank you very much for your help and time for giving key code

Regards,
Moti

KolGuyXcel · Nov 10, 2018

You're welcome!

MARK858 · Nov 10, 2018

Just to post the code for what I suggested adding to Ricks code.

Code:

Sub motilulla()
    Dim lr As Long
    Application.ScreenUpdating = -False
    lr = Cells.Find("*", , xlValues, , xlRows, xlPrevious, , , False).Row
    Range("V6:V" & lr).ClearContents
    With Range("C6:K" & lr)
        .Offset(, 10).Value = .Value
        .Offset(, 10).SpecialCells(xlBlanks).Delete xlShiftToLeft
    End With
    Range("V6:V" & lr).FormulaR1C1 = _
    "=RC[-9]&"" | ""&RC[-8]&"" | ""&RC[-7]&"" | ""&RC[-6]&"" | ""&RC[-5]&"" | ""&RC[-4]&"" | ""&RC[-3]&"" | ""&RC[-2]&"" | ""&RC[-1]&"" | """
    Application.ScreenUpdating = True
End Sub

The above took 52.4 milliseconds to run on the data in post number 1, the code in post number 11 took 243.72 milliseconds to run (170.6 if you turn screenupdating off).
Obviously there is an option of using arrays which would also be fast.

motilulla · Nov 10, 2018

MARK858 said:
Just to post the code for what I suggested adding to Ricks code.

Code:

Sub motilulla() Dim lr As Long Application.ScreenUpdating = -False lr = Cells.Find("*", , xlValues, , xlRows, xlPrevious, , , False).Row Range("V6:V" & lr).ClearContents With Range("C6:K" & lr) .Offset(, 10).Value = .Value .Offset(, 10).SpecialCells(xlBlanks).Delete xlShiftToLeft End With Range("V6:V" & lr).FormulaR1C1 = _ "=RC[-9]&"" | ""&RC[-8]&"" | ""&RC[-7]&"" | ""&RC[-6]&"" | ""&RC[-5]&"" | ""&RC[-4]&"" | ""&RC[-3]&"" | ""&RC[-2]&"" | ""&RC[-1]&"" | """ Application.ScreenUpdating = True End Sub

The above took 52.4 milliseconds to run on the data in post number 1, the code in post number 11 took 243.72 milliseconds to run (170.6 if you turn screenupdating off).
Obviously there is an option of using arrays which would also be fast.

Thank you MARK858, for adding a formula as you suggest. Yes it worked, but I will go with KolGuyXcel, code. Because 1-that keeps the format, 2-if cases I extend my project to right columns also it works fine do not miss match the next columns. Over all seems to me very useful and I find it more versatile macro solution.

I do appreciate your help and time you spent to find a solution. 

Regards,
Moti

MARK858 · Nov 10, 2018

If you mean by "keeps the format" the borders that is just

Code:

Sub motilulla()
    Dim lr As Long
    Application.ScreenUpdating = -False
    lr = Cells.Find("*", , xlValues, , xlRows, xlPrevious, , , False).Row
    Range("V6:V" & lr).ClearContents
    With Range("C6:K" & lr)
        .Offset(, 10).Value = .Value
        .Offset(, 10).SpecialCells(xlBlanks).Delete xlShiftToLeft
        [COLOR="#FF0000"].Offset(, 10).SpecialCells(xlConstants).Borders.Weight = xlMedium[/COLOR]
    End With
    Range("V6:V" & lr).FormulaR1C1 = _
    "=RC[-9]&"" | ""&RC[-8]&"" | ""&RC[-7]&"" | ""&RC[-6]&"" | ""&RC[-5]&"" | ""&RC[-4]&"" | ""&RC[-3]&"" | ""&RC[-2]&"" | ""&RC[-1]&"" | """
    Application.ScreenUpdating = True
End Sub

3 Actions VBA Copy, Clear contents ("") and Shift all to left

motilulla

Well-known Member

KolGuyXcel

Board Regular

Excel Facts

motilulla

Well-known Member

KolGuyXcel

Board Regular

MARK858

MrExcel MVP

motilulla

Well-known Member

MARK858

MrExcel MVP

Similar threads

Forum statistics

Share this page

3 Actions VBA Copy, Clear contents ("") and Shift all to left

motilulla

Well-known Member

KolGuyXcel

Board Regular

Excel Facts

motilulla

Well-known Member

KolGuyXcel

Board Regular

MARK858

MrExcel MVP

motilulla

Well-known Member

MARK858

MrExcel MVP

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock